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 ( name -- vocab ) vocab-name dictionary get at ;
50 GENERIC: vocab-words-assoc ( vocab-spec -- assoc/f )
52 M: vocab vocab-words-assoc words>> ;
54 M: object vocab-words-assoc lookup-vocab vocab-words-assoc ;
56 M: f vocab-words-assoc ;
58 GENERIC: vocab-help ( vocab-spec -- help )
60 M: vocab vocab-help help>> ;
62 M: object vocab-help lookup-vocab vocab-help ;
66 GENERIC: vocab-main ( vocab-spec -- main )
68 M: vocab vocab-main main>> ;
70 M: object vocab-main lookup-vocab vocab-main ;
74 SYMBOL: vocab-observers
76 GENERIC: vocab-changed ( vocab obj -- )
78 : add-vocab-observer ( obj -- )
79 vocab-observers get push ;
81 : remove-vocab-observer ( obj -- )
82 vocab-observers get remove-eq! drop ;
84 : notify-vocab-observers ( vocab -- )
85 vocab-observers get [ vocab-changed ] with each ;
87 : create-vocab ( name -- vocab )
88 check-vocab-name dictionary get
89 [ <vocab> dup notify-vocab-observers ] cache ;
91 ERROR: no-vocab name ;
93 : loaded-vocab-names ( -- seq )
94 dictionary get keys natural-sort ;
96 : vocab-words ( vocab-spec -- seq )
97 vocab-words-assoc values ;
99 : all-words ( -- seq )
100 dictionary get values [ vocab-words ] map concat ;
102 : words-named ( str -- seq )
103 dictionary get values
104 [ vocab-words-assoc at ] with map
107 : child-vocab? ( prefix name -- ? )
111 length swap ?nth CHAR: . =
116 : loaded-child-vocab-names ( vocab-spec -- seq )
117 vocab-name loaded-vocab-names [ child-vocab? ] with filter ;
119 GENERIC: >vocab-link ( name -- vocab )
121 M: vocab-spec >vocab-link ;
123 M: object >vocab-link dup lookup-vocab [ ] [ <vocab-link> ] ?if ;
125 : forget-vocab ( vocab -- )
126 [ vocab-words forget-all ]
127 [ vocab-name dictionary get delete-at ]
128 [ notify-vocab-observers ] tri ;
130 M: vocab-spec forget* forget-vocab ;
134 PREDICATE: runnable-vocab < vocab
135 vocab-main >boolean ;
137 INSTANCE: vocab-spec definition-mixin
139 : call-require-hook ( name -- )
140 require-hook get call( name -- ) ;
142 GENERIC: require ( object -- )
144 M: vocab require name>> require ;
146 M: vocab-link require name>> require ;
148 ! When calling "foo.private" require, load "foo" instead, but only when
149 ! "foo.private" does not exist. The reason for this is that stage1 bootstrap
150 ! starts out with some .private vocabs that contain primitives, and
151 ! loading the public vocabs would cause circularity issues.
152 M: string require ( vocab -- )
153 dup ".private" ?tail [
156 [ nip call-require-hook ]
159 nip call-require-hook
162 : load-vocab ( name -- vocab )
163 [ require ] [ lookup-vocab ] bi ;