1 ! Copyright (C) 2007, 2008 Eduardo Cavazos, Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs strings kernel sorting namespaces
4 sequences definitions ;
9 TUPLE: vocab < identity-tuple
12 source-loaded? docs-loaded? ;
14 : <vocab> ( name -- vocab )
19 GENERIC: vocab-name ( vocab-spec -- name )
21 GENERIC: vocab ( vocab-spec -- vocab )
25 M: object vocab ( name -- vocab ) vocab-name dictionary get at ;
27 M: vocab vocab-name name>> ;
29 M: string vocab-name ;
31 GENERIC: vocab-words ( vocab-spec -- words )
33 M: vocab vocab-words words>> ;
35 M: object vocab-words vocab vocab-words ;
39 GENERIC: vocab-help ( vocab-spec -- help )
41 M: vocab vocab-help help>> ;
43 M: object vocab-help vocab vocab-help ;
47 GENERIC: vocab-main ( vocab-spec -- main )
49 M: vocab vocab-main main>> ;
51 M: object vocab-main vocab vocab-main ;
55 GENERIC: vocab-source-loaded? ( vocab-spec -- ? )
57 M: vocab vocab-source-loaded? source-loaded?>> ;
59 M: object vocab-source-loaded?
60 vocab vocab-source-loaded? ;
62 M: f vocab-source-loaded? ;
64 GENERIC: set-vocab-source-loaded? ( ? vocab-spec -- )
66 M: vocab set-vocab-source-loaded? (>>source-loaded?) ;
68 M: object set-vocab-source-loaded?
69 vocab set-vocab-source-loaded? ;
71 M: f set-vocab-source-loaded? 2drop ;
73 GENERIC: vocab-docs-loaded? ( vocab-spec -- ? )
75 M: vocab vocab-docs-loaded? docs-loaded?>> ;
77 M: object vocab-docs-loaded?
78 vocab vocab-docs-loaded? ;
80 M: f vocab-docs-loaded? ;
82 GENERIC: set-vocab-docs-loaded? ( ? vocab-spec -- )
84 M: vocab set-vocab-docs-loaded? (>>docs-loaded?) ;
86 M: object set-vocab-docs-loaded?
87 vocab set-vocab-docs-loaded? ;
89 M: f set-vocab-docs-loaded? 2drop ;
91 : create-vocab ( name -- vocab )
92 dictionary get [ <vocab> ] cache ;
94 ERROR: no-vocab name ;
96 SYMBOL: load-vocab-hook ! ( name -- )
98 : load-vocab ( name -- vocab )
99 dup load-vocab-hook get call vocab ;
102 dictionary get keys natural-sort ;
104 : words ( vocab -- seq )
107 : all-words ( -- seq )
108 dictionary get values [ words ] map concat ;
110 : words-named ( str -- seq )
111 dictionary get values
112 [ vocab-words at ] with map
115 : child-vocab? ( prefix name -- ? )
116 2dup = pick empty? or
117 [ 2drop t ] [ swap CHAR: . suffix head? ] if ;
119 : child-vocabs ( vocab -- seq )
120 vocab-name vocabs [ child-vocab? ] with filter ;
122 TUPLE: vocab-link name ;
124 : <vocab-link> ( name -- vocab-link )
127 M: vocab-link hashcode* name>> hashcode* ;
129 M: vocab-link vocab-name name>> ;
131 UNION: vocab-spec vocab vocab-link ;
133 GENERIC: >vocab-link ( name -- vocab )
135 M: vocab-spec >vocab-link ;
137 M: string >vocab-link dup vocab [ ] [ <vocab-link> ] ?if ;
139 : forget-vocab ( vocab -- )
141 vocab-name dictionary get delete-at ;
143 M: vocab-spec forget* forget-vocab ;