1 ! Copyright (C) 2007, 2010 Eduardo Cavazos, Slava Pestov.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs combinators continuations
4 definitions 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
21 [ drop ] add-vocab-root-hook set-global
24 : add-vocab-root ( root -- )
25 absolute-path trim-tail-separators dup vocab-roots get ?adjoin
26 [ add-vocab-root-hook get-global call( root -- ) ] [ drop ] if ;
29 root-cache [ H{ } clone ] initialize
31 ERROR: not-found-in-roots path ;
35 : find-root-for ( path -- path/f )
36 vocab-roots get [ prepend-path file-exists? ] with find nip ;
38 : find-root-for-vocab-pathname ( path -- path/f )
39 dup find-root-for [ prepend-path ] [ not-found-in-roots ] if* ;
41 : ensure-parent-directory-is-not-dot ( path -- parent-directory )
42 dup parent-directory dup "." =
43 [ drop not-found-in-roots ]
46 ! If path exists use it, otherwise try to find a vocab that exists
52 { [ dup ?last path-separator? ] [ find-root-for-vocab-pathname ] }
53 { [ dup has-file-extension? ] [
54 [ ensure-parent-directory-is-not-dot find-root-for-vocab-pathname ]
55 [ file-name ] bi append-path
57 [ find-root-for-vocab-pathname ]
63 : vocab-dir ( vocab -- dir )
64 vocab-name H{ { CHAR: . CHAR: / } } substitute ;
66 : append-vocab-dir ( vocab str/f -- path )
67 [ vocab-name "." split ] dip
68 [ [ dup last ] dip append suffix ] when*
71 : find-vocab-root ( vocab -- path/f )
72 vocab-name dup ".private" tail? [ drop f ] [
73 root-cache get 2dup at [ 2nip ] [
74 over ".factor" append-vocab-dir find-root-for
75 [ [ -rot set-at ] [ 2drop ] if* ] keep
79 : vocab-exists? ( name -- ? )
80 [ lookup-vocab ] [ find-vocab-root ] ?unless ;
82 : vocab-append-path ( vocab path -- newpath )
83 swap find-vocab-root [ prepend-path ] [ drop f ] if* ;
85 : vocab-source-path ( vocab -- path/f )
86 vocab-name ".private" ?tail drop
87 dup ".factor" append-vocab-dir vocab-append-path ;
89 : vocab-docs-path ( vocab -- path/f )
90 vocab-name ".private" ?tail drop
91 dup "-docs.factor" append-vocab-dir vocab-append-path ;
95 ! Defined by vocabs.metadata
96 SYMBOL: check-vocab-hook
97 check-vocab-hook [ [ drop ] ] initialize
101 SYMBOL: require-when-vocabs
102 require-when-vocabs [ HS{ } clone ] initialize
104 SYMBOL: require-when-table
105 require-when-table [ V{ } clone ] initialize
107 : load-conditional-requires ( vocab -- )
108 vocab-name require-when-vocabs get in? [
109 require-when-table get [
110 [ [ lookup-vocab dup [ source-loaded?>> +done+ = ] when ] all? ] dip
111 [ require ] curry when
115 : load-source ( vocab -- )
116 dup check-vocab-hook get call( vocab -- )
118 +parsing+ >>source-loaded?
119 dup vocab-source-path [ parse-file ] [ [ ] ] if*
120 [ +parsing+ >>source-loaded? ] dip
121 [ % ] [ call( -- ) ] if-bootstrapping
122 +done+ >>source-loaded?
123 load-conditional-requires
124 ] [ ] [ f >>source-loaded? ] cleanup ;
126 : load-docs ( vocab -- )
129 +parsing+ >>docs-loaded?
130 dup vocab-docs-path [ ?run-file ] when*
131 +done+ >>docs-loaded?
132 ] [ ] [ f >>docs-loaded? ] cleanup
137 : require-when ( if then -- )
138 over [ lookup-vocab ] all? [
141 [ drop require-when-vocabs get adjoin-all ]
142 [ 2array require-when-table get push ] 2bi
147 f >>source-loaded? f >>docs-loaded? drop
151 [ load-vocab vocab-main ]
154 "The " write vocab-name write
155 " vocabulary does not define an entry point." print
156 "To define one, refer to \\ MAIN: help" print
161 GENERIC: (require) ( name -- )
164 dup source-loaded?>> +parsing+ eq? [
165 dup source-loaded?>> [ dup load-source ] unless
166 dup docs-loaded?>> [ dup load-docs ] unless
169 M: vocab-link (require)
170 vocab-name (require) ;
173 dup check-vocab-hook get call( vocab -- )
174 create-vocab (require) ;
181 [ dup lookup-vocab [ drop ] [ no-vocab ] if ]
183 ] require-hook set-global
185 M: vocab-spec where vocab-source-path dup [ 1 2array ] when ;
187 ! put here to avoid circularity between vocabs.loader and source-files.errors
188 { "source-files.errors" "debugger" } "source-files.errors.debugger" require-when