/core/source-files/source-files.factor

 1! Copyright (C) 2007, 2009 Slava Pestov.
 2! See http://factorcode.org/license.txt for BSD license.
 3USING: accessors arrays assocs checksums checksums.crc32
 4compiler.units continuations definitions io.encodings.utf8
 5io.files io.pathnames kernel namespaces sequences
 6source-files.errors strings words ;
 7IN: source-files
 8
 9SYMBOL: source-files
10
11TUPLE: source-file
12path
13top-level-form
14checksum
15definitions
16main ;
17
18: record-top-level-form ( quot file -- )
19    top-level-form<<
20    [ ] [ H{ } notify-definition-observers ] if-bootstrapping ;
21
22: record-checksum ( lines source-file -- )
23    [ crc32 checksum-lines ] dip checksum<< ;
24
25: record-definitions ( file -- )
26    new-definitions get >>definitions drop ;
27
28: <source-file> ( path -- source-file )
29    \ source-file new
30        swap >>path
31        <definitions> >>definitions ;
32
33ERROR: invalid-source-file-path path ;
34
35: source-file ( path -- source-file )
36    dup string? [ invalid-source-file-path ] unless
37    source-files get [ <source-file> ] cache ;
38
39: reset-checksums ( -- )
40    source-files get [
41        swap dup exists? [
42            utf8 file-lines swap record-checksum
43        ] [ 2drop ] if
44    ] assoc-each ;
45
46M: pathname where string>> 1 2array ;
47
48: forget-source ( path -- )
49    source-files get delete-at*
50    [ definitions>> [ keys forget-all ] each ] [ drop ] if ;
51
52M: pathname forget*
53    string>> forget-source ;
54
55: rollback-source-file ( file -- )
56    [
57        new-definitions get [ assoc-union ] 2map
58    ] change-definitions drop ;
59
60SYMBOL: file
61
62: wrap-source-file-error ( error -- * )
63    file get rollback-source-file
64    \ source-file-error new
65        f >>line#
66        file get path>> >>file
67        swap >>error rethrow ;
68
69: with-source-file ( name quot -- )
70    #! Should be called from inside with-compilation-unit.
71    [
72        [
73            source-file
74            [ file set ]
75            [ definitions>> old-definitions set ] bi
76        ] dip
77        [ wrap-source-file-error ] recover
78    ] with-scope ; inline