1 ! Copyright (C) 2007, 2008 Slava Pestov.
\r
2 ! See http://factorcode.org/license.txt for BSD license.
\r
3 USING: kernel io io.styles io.files io.encodings.utf8
\r
4 vocabs.loader vocabs sequences namespaces math.parser arrays
\r
5 hashtables assocs memoize summary sorting splitting combinators
\r
6 source-files debugger continuations compiler.errors init
\r
7 checksums checksums.crc32 sets ;
\r
10 : vocab-tests-file ( vocab -- path )
\r
11 dup "-tests.factor" vocab-dir+ vocab-append-path dup
\r
12 [ dup exists? [ drop f ] unless ] [ drop f ] if ;
\r
14 : vocab-tests-dir ( vocab -- paths )
\r
15 dup vocab-dir "tests" append-path vocab-append-path dup [
\r
18 [ ".factor" tail? ] filter
\r
19 [ append-path ] with map
\r
23 : vocab-tests ( vocab -- tests )
\r
25 [ vocab-tests-file [ , ] when* ]
\r
26 [ vocab-tests-dir [ % ] when* ] bi
\r
29 : vocab-files ( vocab -- seq )
\r
31 [ vocab-source-path [ , ] when* ]
\r
32 [ vocab-docs-path [ , ] when* ]
\r
33 [ vocab-tests % ] tri
\r
36 : vocab-heading. ( vocab -- )
\r
39 [ vocab-name ] [ vocab write-object ] bi ":" print
\r
42 : load-error. ( triple -- )
\r
43 [ first vocab-heading. ] [ second print-error ] bi ;
\r
45 : load-failures. ( failures -- )
\r
46 [ load-error. nl ] each ;
\r
50 : require-all ( vocabs -- failures )
\r
52 V{ } clone blacklist set
\r
53 V{ } clone failures set
\r
56 [ swap vocab-name failures get set-at ]
\r
60 ] with-compiler-errors ;
\r
62 : source-modified? ( path -- ? )
\r
63 dup source-files get at [
\r
64 dup source-file-path
\r
66 utf8 file-lines crc32 checksum-lines
\r
67 swap source-file-checksum = not
\r
75 SYMBOL: changed-vocabs
\r
77 [ f changed-vocabs set-global ] "tools.vocabs" add-init-hook
\r
79 : changed-vocab ( vocab -- )
\r
80 dup vocab changed-vocabs get and
\r
81 [ dup changed-vocabs get set-at ] [ drop ] if ;
\r
83 : unchanged-vocab ( vocab -- )
\r
84 changed-vocabs get delete-at ;
\r
86 : unchanged-vocabs ( vocabs -- )
\r
87 [ unchanged-vocab ] each ;
\r
89 : changed-vocab? ( vocab -- ? )
\r
90 changed-vocabs get dup [ key? ] [ 2drop t ] if ;
\r
92 : filter-changed ( vocabs -- vocabs' )
\r
93 [ changed-vocab? ] filter ;
\r
95 SYMBOL: modified-sources
\r
96 SYMBOL: modified-docs
\r
98 : (to-refresh) ( vocab variable loaded? path -- )
\r
101 pick changed-vocab? [
\r
102 source-modified? [ get push ] [ 2drop ] if
\r
104 ] [ drop get push ] if
\r
105 ] [ 2drop 2drop ] if ;
\r
107 : to-refresh ( prefix -- modified-sources modified-docs unchanged )
\r
109 V{ } clone modified-sources set
\r
110 V{ } clone modified-docs set
\r
115 [ modified-sources ]
\r
116 [ vocab-source-loaded? ]
\r
117 [ vocab-source-path ]
\r
121 [ vocab-docs-loaded? ]
\r
122 [ vocab-docs-path ]
\r
127 modified-sources get
\r
130 [ modified-docs get modified-sources get append diff ] bi
\r
133 : do-refresh ( modified-sources modified-docs unchanged -- )
\r
136 [ [ f swap set-vocab-source-loaded? ] each ]
\r
137 [ [ f swap set-vocab-docs-loaded? ] each ] bi*
\r
141 [ unchanged-vocabs ]
\r
142 [ require-all load-failures. ] bi
\r
145 : refresh ( prefix -- ) to-refresh do-refresh ;
\r
147 : refresh-all ( -- ) "" refresh ;
\r
149 MEMO: vocab-file-contents ( vocab name -- seq )
\r
150 vocab-append-path dup
\r
151 [ dup exists? [ utf8 file-lines ] [ drop f ] if ] when ;
\r
153 : set-vocab-file-contents ( seq vocab name -- )
\r
154 dupd vocab-append-path [
\r
155 utf8 set-file-lines
\r
156 \ vocab-file-contents reset-memoized
\r
158 "The " swap vocab-name
\r
159 " vocabulary was not loaded from the file system"
\r
163 : vocab-summary-path ( vocab -- string )
\r
164 vocab-dir "summary.txt" append-path ;
\r
166 : vocab-summary ( vocab -- summary )
\r
167 dup dup vocab-summary-path vocab-file-contents
\r
169 drop vocab-name " vocabulary" append
\r
176 dup vocab-summary %
\r
178 vocab-words assoc-size #
\r
182 M: vocab-link summary vocab-summary ;
\r
184 : set-vocab-summary ( string vocab -- )
\r
186 dup vocab-summary-path
\r
187 set-vocab-file-contents ;
\r
189 : vocab-tags-path ( vocab -- string )
\r
190 vocab-dir "tags.txt" append-path ;
\r
192 : vocab-tags ( vocab -- tags )
\r
193 dup vocab-tags-path vocab-file-contents ;
\r
195 : set-vocab-tags ( tags vocab -- )
\r
196 dup vocab-tags-path set-vocab-file-contents ;
\r
198 : add-vocab-tags ( tags vocab -- )
\r
199 [ vocab-tags append prune ] keep set-vocab-tags ;
\r
201 : vocab-authors-path ( vocab -- string )
\r
202 vocab-dir "authors.txt" append-path ;
\r
204 : vocab-authors ( vocab -- authors )
\r
205 dup vocab-authors-path vocab-file-contents ;
\r
207 : set-vocab-authors ( authors vocab -- )
\r
208 dup vocab-authors-path set-vocab-file-contents ;
\r
210 : subdirs ( dir -- dirs )
\r
211 directory [ second ] filter keys natural-sort ;
\r
213 : (all-child-vocabs) ( root name -- vocabs )
\r
214 [ vocab-dir append-path subdirs ] keep
\r
218 swap [ "." swap 3append ] with map
\r
221 : vocabs-in-dir ( root name -- )
\r
222 dupd (all-child-vocabs) [
\r
223 2dup vocab-dir? [ dup >vocab-link , ] when
\r
227 : all-vocabs ( -- assoc )
\r
229 dup [ "" vocabs-in-dir ] { } make
\r
232 MEMO: all-vocabs-seq ( -- seq )
\r
233 all-vocabs values concat ;
\r
235 : dangerous? ( name -- ? )
\r
238 { [ "cpu." ?head ] [ t ] }
\r
239 { [ "io.unix" ?head ] [ t ] }
\r
240 { [ "io.windows" ?head ] [ t ] }
\r
241 { [ "ui.x11" ?head ] [ t ] }
\r
242 { [ "ui.windows" ?head ] [ t ] }
\r
243 { [ "ui.cocoa" ?head ] [ t ] }
\r
244 { [ "cocoa" ?head ] [ t ] }
\r
245 { [ "core-foundation" ?head ] [ t ] }
\r
246 { [ "vocabs.loader.test" ?head ] [ t ] }
\r
247 { [ "editors." ?head ] [ t ] }
\r
248 { [ ".windows" ?tail ] [ t ] }
\r
249 { [ ".unix" ?tail ] [ t ] }
\r
250 { [ "unix" ?head ] [ t ] }
\r
251 { [ ".linux" ?tail ] [ t ] }
\r
252 { [ ".bsd" ?tail ] [ t ] }
\r
253 { [ ".macosx" ?tail ] [ t ] }
\r
254 { [ "windows." ?head ] [ t ] }
\r
255 { [ "cocoa" ?head ] [ t ] }
\r
256 { [ ".test" ?tail ] [ t ] }
\r
257 { [ "raptor" ?head ] [ t ] }
\r
258 { [ dup "tools.deploy.app" = ] [ t ] }
\r
262 : filter-dangerous ( seq -- seq' )
\r
263 [ vocab-name dangerous? not ] filter ;
\r
265 : try-everything ( -- failures )
\r
270 : load-everything ( -- )
\r
271 try-everything load-failures. ;
\r
273 : unrooted-child-vocabs ( prefix -- seq )
\r
274 dup empty? [ CHAR: . suffix ] unless
\r
276 [ find-vocab-root not ] filter
\r
278 vocab-name swap ?head CHAR: . rot member? not and
\r
282 : all-child-vocabs ( prefix -- assoc )
\r
284 dup pick (all-child-vocabs) [ >vocab-link ] map
\r
286 swap unrooted-child-vocabs f swap 2array suffix ;
\r
288 : all-child-vocabs-seq ( prefix -- assoc )
\r
289 vocab-roots get swap [
\r
290 dupd (all-child-vocabs)
\r
291 [ vocab-dir? ] with filter
\r
292 ] curry map concat ;
\r
294 MEMO: all-tags ( -- seq )
\r
295 all-vocabs-seq [ vocab-tags ] gather natural-sort ;
\r
297 MEMO: all-authors ( -- seq )
\r
298 all-vocabs-seq [ vocab-authors ] gather natural-sort ;
\r
300 : reset-cache ( -- )
\r
301 root-cache get-global clear-assoc
\r
302 \ vocab-file-contents reset-memoized
\r
303 \ all-vocabs-seq reset-memoized
\r
304 \ all-authors reset-memoized
\r
305 \ all-tags reset-memoized ;
\r