1 ! Copyright (C) 2007, 2010 Eduardo Cavazos, Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: namespaces make sequences io io.files io.pathnames kernel
4 assocs words vocabs definitions parser continuations hashtables
5 sorting source-files arrays combinators strings system
6 math.parser splitting init accessors sets ;
11 SYMBOL: add-vocab-root-hook
19 } clone vocab-roots set-global
21 [ drop ] add-vocab-root-hook set-global
22 ] "vocabs.loader" add-startup-hook
24 : add-vocab-root ( root -- )
26 [ vocab-roots get adjoin ]
27 [ add-vocab-root-hook get-global call( root -- ) ] bi ;
31 root-cache [ H{ } clone ] initialize
33 ERROR: not-found-in-roots path ;
37 : find-root-for ( path -- path/f )
38 vocab-roots get [ prepend-path exists? ] with find nip ;
40 M: string vocab-path ( string -- path/f )
41 dup find-root-for [ prepend-path ] [ not-found-in-roots ] if* ;
45 : vocab-dir ( vocab -- dir )
46 vocab-name { { CHAR: . CHAR: / } } substitute ;
48 ERROR: absolute-path-forbidden path ;
50 : forbid-absolute-path ( str -- str )
51 dup absolute-path? [ absolute-path-forbidden ] when ;
53 : append-vocab-dir ( vocab str/f -- path )
54 [ vocab-name forbid-absolute-path "." split ] dip
55 [ [ dup last ] dip append suffix ] when*
58 : find-vocab-root ( vocab -- path/f )
59 vocab-name dup root-cache get at
60 [ ] [ ".factor" append-vocab-dir find-root-for ] ?if ;
62 : vocab-append-path ( vocab path -- newpath )
63 swap find-vocab-root dup [ prepend-path ] [ 2drop f ] if ;
65 : vocab-source-path ( vocab -- path/f )
66 dup ".factor" append-vocab-dir vocab-append-path ;
68 : vocab-docs-path ( vocab -- path/f )
69 dup "-docs.factor" append-vocab-dir vocab-append-path ;
73 ! Defined by vocabs.metadata
74 SYMBOL: check-vocab-hook
76 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 [ [ 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 [ vocab-docs-path [ ?run-file ] when* ] keep
112 +done+ >>docs-loaded?
113 ] [ ] [ f >>docs-loaded? ] cleanup
118 : require ( vocab -- )
121 : require-when ( if then -- )
122 over [ vocab ] all? [
125 [ drop [ require-when-vocabs get adjoin ] each ]
126 [ 2array require-when-table get push ] 2bi
131 [ [ load-source ] [ load-docs ] bi ]
136 dup load-vocab vocab-main [
139 "The " write vocab-name write
140 " vocabulary does not define an entry point." print
141 "To define one, refer to \\ MAIN: help" print
148 : add-to-blacklist ( error vocab -- )
149 vocab-name blacklist get dup [ set-at ] [ 3drop ] if ;
151 GENERIC: (load-vocab) ( name -- vocab )
153 M: vocab (load-vocab)
155 dup source-loaded?>> +parsing+ eq? [
156 dup source-loaded?>> [ dup load-source ] unless
157 dup docs-loaded?>> [ dup load-docs ] unless
159 ] [ [ swap add-to-blacklist ] keep rethrow ] recover ;
161 M: vocab-link (load-vocab)
162 vocab-name (load-vocab) ;
164 M: string (load-vocab) create-vocab (load-vocab) ;
169 dup vocab-name blacklist get at* [ rethrow ] [
170 drop dup find-vocab-root
171 [ (load-vocab) ] [ dup vocab [ ] [ no-vocab ] ?if ] if
173 ] load-vocab-hook set-global
175 M: vocab-spec where vocab-source-path dup [ 1 2array ] when ;