1 ! Copyright (C) 2007, 2010 Eduardo Cavazos, Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs combinators continuations
4 definitions init io io.files io.pathnames kernel make namespaces
5 parser 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 file-exists? ] with find nip ;
39 : find-root-for-vocab-pathname ( path -- path/f )
40 dup find-root-for [ prepend-path ] [ not-found-in-roots ] if* ;
42 : ensure-parent-directory-is-not-dot ( path -- parent-directory )
43 dup parent-directory dup "." =
44 [ drop not-found-in-roots ]
49 { [ dup ?last path-separator? ] [ find-root-for-vocab-pathname ] }
50 { [ dup has-file-extension? ] [
51 [ ensure-parent-directory-is-not-dot find-root-for-vocab-pathname ]
52 [ file-name ] bi append-path
54 [ find-root-for-vocab-pathname ]
59 : vocab-dir ( vocab -- dir )
60 vocab-name H{ { CHAR: . CHAR: / } } substitute ;
62 : append-vocab-dir ( vocab str/f -- path )
63 [ vocab-name "." split ] dip
64 [ [ dup last ] dip append suffix ] when*
67 : find-vocab-root ( vocab -- path/f )
68 vocab-name dup ".private" tail? [ drop f ] [
69 root-cache get 2dup at [ 2nip ] [
70 over ".factor" append-vocab-dir find-root-for
71 [ [ -rot set-at ] [ 2drop ] if* ] keep
75 : vocab-exists? ( name -- ? )
76 dup lookup-vocab [ ] [ find-vocab-root ] ?if ;
78 : vocab-append-path ( vocab path -- newpath )
79 swap find-vocab-root [ prepend-path ] [ drop f ] if* ;
81 : vocab-source-path ( vocab -- path/f )
82 vocab-name ".private" ?tail drop
83 dup ".factor" append-vocab-dir vocab-append-path ;
85 : vocab-docs-path ( vocab -- path/f )
86 vocab-name ".private" ?tail drop
87 dup "-docs.factor" append-vocab-dir vocab-append-path ;
91 ! Defined by vocabs.metadata
92 SYMBOL: check-vocab-hook
93 check-vocab-hook [ [ drop ] ] initialize
97 SYMBOL: require-when-vocabs
98 require-when-vocabs [ HS{ } clone ] initialize
100 SYMBOL: require-when-table
101 require-when-table [ V{ } clone ] initialize
103 : load-conditional-requires ( vocab -- )
104 vocab-name require-when-vocabs get in? [
105 require-when-table get [
106 [ [ lookup-vocab dup [ source-loaded?>> +done+ = ] when ] all? ] dip
107 [ require ] curry when
111 : load-source ( vocab -- )
112 dup check-vocab-hook get call( vocab -- )
114 +parsing+ >>source-loaded?
115 dup vocab-source-path [ parse-file ] [ [ ] ] if*
116 [ +parsing+ >>source-loaded? ] dip
117 [ % ] [ call( -- ) ] if-bootstrapping
118 +done+ >>source-loaded?
119 load-conditional-requires
120 ] [ ] [ f >>source-loaded? ] cleanup ;
122 : load-docs ( vocab -- )
125 +parsing+ >>docs-loaded?
126 dup vocab-docs-path [ ?run-file ] when*
127 +done+ >>docs-loaded?
128 ] [ ] [ f >>docs-loaded? ] cleanup
133 : require-when ( if then -- )
134 over [ lookup-vocab ] all? [
137 [ drop require-when-vocabs get adjoin-all ]
138 [ 2array require-when-table get push ] 2bi
143 [ [ load-source ] [ load-docs ] bi ]
148 dup load-vocab vocab-main [
151 "The " write vocab-name write
152 " vocabulary does not define an entry point." print
153 "To define one, refer to \\ MAIN: help" print
160 : add-to-errorlist ( error vocab -- )
161 vocab-name errorlist get [ set-at ] [ 2drop ] if* ;
163 : remove-from-errorlist ( vocab -- )
164 vocab-name errorlist get [ delete-at ] [ drop ] if* ;
166 GENERIC: (require) ( name -- )
171 dup source-loaded?>> +parsing+ eq? [ drop ] [
172 dup source-loaded?>> [ dup load-source ] unless
173 dup docs-loaded?>> [ dup load-docs ] unless
177 remove-from-errorlist
179 ] [ [ swap add-to-errorlist ] keep rethrow ] recover ;
181 M: vocab-link (require)
182 vocab-name (require) ;
185 dup check-vocab-hook get call( vocab -- )
186 create-vocab (require) ;
190 : require-all ( vocabs -- )
191 V{ } clone errorlist [ [ require ] each ] with-variable ;
194 dup vocab-name errorlist get at*
197 drop dup find-vocab-root
199 [ dup lookup-vocab [ drop ] [ no-vocab ] if ]
202 ] require-hook set-global
204 M: vocab-spec where vocab-source-path dup [ 1 2array ] when ;
206 ! put here to avoid circularity between vocabs.loader and source-files.errors
207 { "source-files.errors" "debugger" } "source-files.errors.debugger" require-when