1 ! Copyright (C) 2007, 2009 Eduardo Cavazos, Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs definitions kernel namespaces sequences
4 sets sorting splitting strings ;
9 TUPLE: vocab < identity-tuple
12 source-loaded? docs-loaded? ;
14 ! sources-loaded? and docs-loaded? slots could be
15 SYMBOLS: +parsing+ +done+ ;
17 : <vocab> ( name -- vocab )
22 ERROR: bad-vocab-name name ;
24 : check-vocab-name ( name -- name )
25 dup string? [ bad-vocab-name ] unless
26 dup [ ":/\\ " member? ] any? [ bad-vocab-name ] when ;
28 TUPLE: vocab-link name ;
30 C: <vocab-link> vocab-link
32 UNION: vocab-spec vocab vocab-link ;
34 INSTANCE: vocab-spec definition-mixin
36 GENERIC: vocab-name ( vocab-spec -- name )
38 M: vocab vocab-name name>> ;
40 M: vocab-link vocab-name name>> ;
42 M: object vocab-name check-vocab-name ;
44 GENERIC: lookup-vocab ( vocab-spec -- vocab )
46 M: vocab lookup-vocab ;
48 M: object lookup-vocab vocab-name dictionary get at ;
50 ERROR: no-vocab-named name ;
52 : ?lookup-vocab ( vocab-spec -- vocab )
53 dup lookup-vocab [ nip ] [ no-vocab-named ] if* ;
55 GENERIC: vocab-words-assoc ( vocab-spec -- assoc/f )
57 M: vocab vocab-words-assoc words>> ;
59 M: object vocab-words-assoc lookup-vocab vocab-words-assoc ;
61 M: f vocab-words-assoc ;
63 GENERIC: vocab-help ( vocab-spec -- help )
65 M: vocab vocab-help help>> ;
67 M: object vocab-help lookup-vocab vocab-help ;
71 GENERIC: vocab-main ( vocab-spec -- main )
73 M: vocab vocab-main main>> ;
75 M: object vocab-main lookup-vocab vocab-main ;
79 PREDICATE: runnable-vocab < vocab
82 SYMBOL: vocab-observers
84 GENERIC: vocab-changed ( vocab obj -- )
86 : add-vocab-observer ( obj -- )
87 vocab-observers get push ;
89 : remove-vocab-observer ( obj -- )
90 vocab-observers get remove-eq! drop ;
92 : notify-vocab-observers ( vocab -- )
93 vocab-observers get [ vocab-changed ] with each ;
95 : create-vocab ( name -- vocab )
96 check-vocab-name dictionary get [ <vocab> ] cache
97 dup notify-vocab-observers ;
99 ERROR: no-vocab name ;
101 : loaded-vocab-names ( -- seq )
102 dictionary get keys natural-sort ;
104 : vocab-words ( vocab-spec -- seq )
105 vocab-words-assoc values ;
107 : all-words ( -- seq )
108 dictionary get values [ vocab-words ] map concat ;
110 : words-named ( str -- seq )
112 [ values [ vocab-words-assoc at ] with map sift ]
114 [ ":" split1 swap ] dip at
115 [ vocab-words-assoc at [ suffix ] when* ] [ drop ] if*
118 : child-vocab? ( prefix name -- ? )
122 length swap ?nth CHAR: . =
127 : loaded-child-vocab-names ( vocab-spec -- seq )
128 vocab-name loaded-vocab-names [ child-vocab? ] with filter ;
130 GENERIC: >vocab-link ( name -- vocab )
132 M: vocab-spec >vocab-link ;
134 M: object >vocab-link dup lookup-vocab [ ] [ <vocab-link> ] ?if ;
138 : (forget-vocab) ( vocab -- )
139 [ vocab-words forget-all ]
140 [ vocab-name dictionary get delete-at ]
141 [ notify-vocab-observers ] tri ;
145 : forget-vocab ( vocab -- )
147 vocab-name dup ".private" tail? [ drop ] [
148 ".private" append (forget-vocab)
152 M: vocab-spec forget* forget-vocab ;
160 : with-requiring ( quot -- )
164 HS{ } clone dup requiring [ swap call ] with-variable
169 GENERIC: require ( object -- )
171 M: vocab require name>> require ;
173 M: vocab-link require name>> require ;
175 ! When calling "foo.private" require, load "foo" instead, but
176 ! only when "foo.private" does not exist. The reason for this is
177 ! that stage1 bootstrap starts out with some .private vocabs
178 ! that contain primitives, and loading the public vocabs would
179 ! cause circularity issues.
181 [ ".private" ?tail ] keep swap [ lookup-vocab not ] when [
184 [ require-hook get call( name -- ) ] [ drop ] if
188 : require-all ( vocabs -- )
191 : load-vocab ( name -- vocab )
192 [ require ] [ lookup-vocab ] bi ;
194 : ?load-vocab ( name -- vocab )
195 [ require ] [ ?lookup-vocab ] bi ;