1 ! Copyright (C) 2007, 2010 Eduardo Cavazos, Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs continuations definitions init
4 io io.files io.pathnames kernel make namespaces parser
5 sequences sets splitting strings vocabs words ;
10 SYMBOL: add-vocab-root-hook
12 CONSTANT: default-vocab-roots {
20 default-vocab-roots V{ } like vocab-roots set-global
22 [ drop ] add-vocab-root-hook set-global
23 ] "vocabs.loader" add-startup-hook
25 : add-vocab-root ( root -- )
26 trim-tail-separators dup vocab-roots get ?adjoin
27 [ add-vocab-root-hook get-global call( root -- ) ] [ drop ] if ;
30 root-cache [ H{ } clone ] initialize
32 ERROR: not-found-in-roots path ;
36 : find-root-for ( path -- path/f )
37 vocab-roots get [ prepend-path exists? ] with find nip ;
40 dup find-root-for [ prepend-path ] [ not-found-in-roots ] if* ;
44 : vocab-dir ( vocab -- dir )
45 vocab-name H{ { CHAR: . CHAR: / } } substitute ;
47 : append-vocab-dir ( vocab str/f -- path )
48 [ vocab-name "." split ] dip
49 [ [ dup last ] dip append suffix ] when*
52 : find-vocab-root ( vocab -- path/f )
53 vocab-name dup ".private" tail? [ drop f ] [
54 root-cache get 2dup at [ 2nip ] [
55 over ".factor" append-vocab-dir find-root-for
56 [ [ -rot set-at ] [ 2drop ] if* ] keep
60 : vocab-exists? ( name -- ? )
61 dup lookup-vocab [ ] [ find-vocab-root ] ?if ;
63 : vocab-append-path ( vocab path -- newpath )
64 swap find-vocab-root [ prepend-path ] [ drop f ] if* ;
66 : vocab-source-path ( vocab -- path/f )
67 vocab-name ".private" ?tail drop
68 dup ".factor" append-vocab-dir vocab-append-path ;
70 : vocab-docs-path ( vocab -- path/f )
71 vocab-name ".private" ?tail drop
72 dup "-docs.factor" append-vocab-dir vocab-append-path ;
76 ! Defined by vocabs.metadata
77 SYMBOL: check-vocab-hook
78 check-vocab-hook [ [ drop ] ] initialize
82 SYMBOL: require-when-vocabs
83 require-when-vocabs [ HS{ } clone ] initialize
85 SYMBOL: require-when-table
86 require-when-table [ V{ } clone ] initialize
88 : load-conditional-requires ( vocab -- )
89 vocab-name require-when-vocabs get in? [
90 require-when-table get [
91 [ [ lookup-vocab dup [ source-loaded?>> +done+ = ] when ] all? ] dip
92 [ require ] curry when
96 : load-source ( vocab -- )
97 dup check-vocab-hook get call( vocab -- )
99 +parsing+ >>source-loaded?
100 dup vocab-source-path [ parse-file ] [ [ ] ] if*
101 [ +parsing+ >>source-loaded? ] dip
102 [ % ] [ call( -- ) ] if-bootstrapping
103 +done+ >>source-loaded?
104 load-conditional-requires
105 ] [ ] [ f >>source-loaded? ] cleanup ;
107 : load-docs ( vocab -- )
110 +parsing+ >>docs-loaded?
111 dup vocab-docs-path [ ?run-file ] when*
112 +done+ >>docs-loaded?
113 ] [ ] [ f >>docs-loaded? ] cleanup
118 : require-when ( if then -- )
119 over [ lookup-vocab ] all? [
122 [ drop require-when-vocabs get adjoin-all ]
123 [ 2array require-when-table get push ] 2bi
128 [ [ load-source ] [ load-docs ] bi ]
133 dup load-vocab vocab-main [
136 "The " write vocab-name write
137 " vocabulary does not define an entry point." print
138 "To define one, refer to \\ MAIN: help" print
145 : add-to-errorlist ( error vocab -- )
146 vocab-name errorlist get [ set-at ] [ 2drop ] if* ;
148 GENERIC: (require) ( name -- )
152 dup source-loaded?>> +parsing+ eq? [ drop ] [
153 dup source-loaded?>> [ dup load-source ] unless
154 dup docs-loaded?>> [ dup load-docs ] unless
157 ] [ [ swap add-to-errorlist ] keep rethrow ] recover ;
159 M: vocab-link (require)
160 vocab-name (require) ;
163 dup check-vocab-hook get call( vocab -- )
164 create-vocab (require) ;
168 : require-all ( vocabs -- )
169 V{ } clone errorlist [ [ require ] each ] with-variable ;
172 dup vocab-name errorlist get at*
175 drop dup find-vocab-root
177 [ dup lookup-vocab [ drop ] [ no-vocab ] if ]
180 ] require-hook set-global
182 M: vocab-spec where vocab-source-path dup [ 1 2array ] when ;
184 ! put here to avoid circularity between vocabs.loader and source-files.errors
185 { "source-files.errors" "debugger" } "source-files.errors.debugger" require-when