1 ! Copyright (C) 2004, 2006 Slava Pestov.
\r
2 ! See http://factorcode.org/license.txt for BSD license.
\r
4 USING: arrays errors generic hashtables io kernel math
\r
5 namespaces sequences words ;
\r
9 TUPLE: source-file path modified definitions ;
\r
11 : source-file-modified* ( source-file -- n )
\r
12 source-file-path ?resource-path
\r
13 file-modified [ 0 ] unless* ;
\r
15 : record-modified ( file -- )
\r
16 dup source-file-modified* swap set-source-file-modified ;
\r
18 : reset-modified ( -- )
\r
19 source-files get hash-values [ record-modified ] each ;
\r
21 C: source-file ( path -- source-file )
\r
22 [ set-source-file-path ] keep
\r
23 V{ } clone over set-source-file-definitions
\r
24 dup record-modified ;
\r
26 : source-modified? ( file -- ? )
\r
27 source-files get hash [
\r
28 dup source-file-modified swap source-file-modified*
\r
29 [ < ] [ drop f ] if*
\r
34 : file-vocabs ( -- )
\r
35 "scratchpad" set-in { "syntax" "scratchpad" } set-use ;
\r
37 : with-parser ( quot -- )
\r
40 dup [ parse-error? ] is? [ <parse-error> ] unless
\r
45 : parse-lines ( lines -- quot )
\r
47 dup length f [ 1+ line-number set (parse) ] 2reduce
\r
51 : parse ( str -- quot ) <string-reader> lines parse-lines ;
\r
53 : eval ( str -- ) parse call ;
\r
57 : do-parse-hook ( -- ) parse-hook get call ;
\r
59 : parse-stream ( stream name -- quot )
\r
61 file set file-vocabs
\r
66 : parsing-file ( file -- )
\r
67 "Loading " write write-pathname terpri flush ;
\r
69 : record-file ( file -- )
\r
70 [ <source-file> ] keep source-files get set-hash ;
\r
72 : parse-file-restarts ( file -- restarts )
\r
73 "Load " swap " again" append3 t 2array 1array ;
\r
75 : parse-file ( file -- quot )
\r
77 dup parsing-file dup record-file
\r
78 [ ?resource-path <file-reader> ] keep parse-stream
\r
80 over parse-file-restarts <condition> rethrow drop
\r
84 : run-file ( file -- ) parse-file call ;
\r
86 : no-parse-hook ( quot -- )
\r
87 [ parse-hook off call ] with-scope ; inline
\r
89 : run-files ( seq -- )
\r
92 [ parse-file % ] [ run-file ] ? each
\r
95 : ?run-file ( file -- )
\r
96 dup exists? [ [ [ run-file ] keep ] try ] when drop ;
\r
98 : eval>string ( str -- str )
\r
99 [ [ [ eval ] keep ] try drop ] string-out ;
\r