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
4 sequences sorting splitting strings ;
9 TUPLE: vocab < identity-tuple
12 source-loaded? docs-loaded? ;
14 ! sources-loaded? slot is one of these three
19 : <vocab> ( name -- vocab )
24 ERROR: bad-vocab-name name ;
26 : check-vocab-name ( name -- name )
27 dup string? [ bad-vocab-name ] unless
28 dup [ ":/\\ " member? ] any? [ bad-vocab-name ] when ;
30 TUPLE: vocab-link name ;
32 C: <vocab-link> vocab-link
34 UNION: vocab-spec vocab vocab-link ;
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 SYMBOL: vocab-observers
81 GENERIC: vocab-changed ( vocab obj -- )
83 : add-vocab-observer ( obj -- )
84 vocab-observers get push ;
86 : remove-vocab-observer ( obj -- )
87 vocab-observers get remove-eq! drop ;
89 : notify-vocab-observers ( vocab -- )
90 vocab-observers get [ vocab-changed ] with each ;
92 : create-vocab ( name -- vocab )
93 check-vocab-name dictionary get [ <vocab> ] cache
94 dup notify-vocab-observers ;
96 ERROR: no-vocab name ;
98 : loaded-vocab-names ( -- seq )
99 dictionary get keys natural-sort ;
101 : vocab-words ( vocab-spec -- seq )
102 vocab-words-assoc values ;
104 : all-words ( -- seq )
105 dictionary get values [ vocab-words ] map concat ;
107 : words-named ( str -- seq )
109 [ values [ vocab-words-assoc at ] with map sift ]
111 [ ":" split1 swap ] dip at
112 [ vocab-words-assoc at [ suffix ] when* ] [ drop ] if*
115 : child-vocab? ( prefix name -- ? )
119 length swap ?nth CHAR: . =
124 : loaded-child-vocab-names ( vocab-spec -- seq )
125 vocab-name loaded-vocab-names [ child-vocab? ] with filter ;
127 GENERIC: >vocab-link ( name -- vocab )
129 M: vocab-spec >vocab-link ;
131 M: object >vocab-link dup lookup-vocab [ ] [ <vocab-link> ] ?if ;
133 : forget-vocab ( vocab -- )
134 [ vocab-words forget-all ]
135 [ vocab-name dictionary get delete-at ]
136 [ notify-vocab-observers ] tri ;
138 M: vocab-spec forget* forget-vocab ;
142 PREDICATE: runnable-vocab < vocab
143 vocab-main >boolean ;
145 INSTANCE: vocab-spec definition-mixin
147 GENERIC: require ( object -- )
149 M: vocab require name>> require ;
151 M: vocab-link require name>> require ;
153 ! When calling "foo.private" require, load "foo" instead, but
154 ! only when "foo.private" does not exist. The reason for this is
155 ! that stage1 bootstrap starts out with some .private vocabs
156 ! that contain primitives, and loading the public vocabs would
157 ! cause circularity issues.
159 [ ".private" ?tail ] keep swap [ lookup-vocab not ] when
160 [ require-hook get call( name -- ) ] [ drop ] if ;
162 : load-vocab ( name -- vocab )
163 [ require ] [ lookup-vocab ] bi ;
165 : ?load-vocab ( name -- vocab )
166 [ require ] [ ?lookup-vocab ] bi ;