Working on faster refresh-all

db4
Slava Pestov 2008-04-09 00:19:56 -05:00
parent 411a137563
commit 52bb93cf40
2 changed files with 56 additions and 40 deletions

View File

@ -1,24 +1,39 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: threads io.files io.monitors init kernel
vocabs.loader tools.vocabs namespaces continuations ;
vocabs vocabs.loader tools.vocabs namespaces continuations
sequences splitting assocs ;
IN: tools.vocabs.monitor
! Use file system change monitoring to flush the tags/authors
! cache
SYMBOL: vocab-monitor
: vocab-dir>vocab-name ( path -- vocab )
left-trim-separators right-trim-separators
{ { CHAR: / CHAR: . } { CHAR: \\ CHAR: . } } substitute ;
: monitor-thread ( -- )
vocab-monitor get-global
next-change 2drop
t sources-changed? set-global reset-cache ;
: path>vocab-name ( path -- vocab )
dup ".factor" tail? [ parent-directory ] when
dup [ vocab-dir>vocab-name ] when ;
: start-monitor-thread
: changed-vocab ( vocab -- )
dup vocab
[ dup changed-vocabs get-global set-at ] [ drop ] if ;
: monitor-thread ( path monitor -- )
#! On OS X, monitors give us the full path, so we chop it
#! off if its there.
next-change drop swap ?head drop
path>vocab-name changed-vocab reset-cache ;
: start-monitor-thread ( root -- )
#! Silently ignore errors during monitor creation since
#! monitors are not supported on all platforms.
(normalize-path) dup t <monitor> [ monitor-thread t ] 2curry
"Vocabulary monitor" spawn-server drop ;
: start-monitor-threads ( -- )
[
"" resource-path t <monitor> vocab-monitor set-global
[ monitor-thread t ] "Vocabulary monitor" spawn-server drop
vocab-roots get [ start-monitor-thread ] each
H{ } clone changed-vocabs set-global
vocabs [ changed-vocab ] each
] ignore-errors ;
[ start-monitor-thread ] "tools.vocabs.monitor" add-init-hook
[ start-monitor-threads ] "tools.vocabs.monitor" add-init-hook

View File

@ -21,15 +21,15 @@ IN: tools.vocabs
: vocab-tests ( vocab -- tests )
[
dup vocab-tests-file [ , ] when*
vocab-tests-dir [ % ] when*
[ vocab-tests-file [ , ] when* ]
[ vocab-tests-dir [ % ] when* ] bi
] { } make ;
: vocab-files ( vocab -- seq )
[
dup vocab-source-path [ , ] when*
dup vocab-docs-path [ , ] when*
vocab-tests %
[ vocab-source-path [ , ] when* ]
[ vocab-docs-path [ , ] when* ]
[ vocab-tests % ] tri
] { } make ;
: source-modified? ( path -- ? )
@ -56,20 +56,27 @@ IN: tools.vocabs
: modified-docs ( vocabs -- seq )
[ vocab-docs-path ] modified ;
SYMBOL: changed-vocabs
[ f changed-vocabs set-global ] "tools.vocabs" add-init-hook
: filter-changed ( vocabs -- vocabs' )
changed-vocabs get [
[ delete-at* nip ] curry subset
] when* ;
: to-refresh ( prefix -- modified-sources modified-docs )
child-vocabs
dup modified-sources swap modified-docs ;
child-vocabs filter-changed
[ modified-sources ] [ modified-docs ] bi ;
: vocab-heading. ( vocab -- )
nl
"==== " write
dup vocab-name swap vocab write-object ":" print
[ vocab-name ] [ vocab write-object ] bi ":" print
nl ;
: load-error. ( triple -- )
dup first vocab-heading.
dup second print-error
drop ;
[ first vocab-heading. ] [ second print-error ] bi ;
: load-failures. ( failures -- )
[ load-error. nl ] each ;
@ -89,30 +96,24 @@ SYMBOL: failures
] with-compiler-errors ;
: do-refresh ( modified-sources modified-docs -- )
2dup
[ f swap set-vocab-docs-loaded? ] each
[ f swap set-vocab-source-loaded? ] each
append prune require-all load-failures. ;
[
[ [ f swap set-vocab-source-loaded? ] each ]
[ [ f swap set-vocab-docs-loaded? ] each ] bi*
]
[ append prune require-all load-failures. ] 2bi ;
: refresh ( prefix -- ) to-refresh do-refresh ;
SYMBOL: sources-changed?
: refresh-all ( -- ) "" refresh ;
[ t sources-changed? set-global ] "tools.vocabs" add-init-hook
: refresh-all ( -- )
"" refresh f sources-changed? set-global ;
MEMO: (vocab-file-contents) ( path -- lines )
dup exists? [ utf8 file-lines ] [ drop f ] if ;
: vocab-file-contents ( vocab name -- seq )
vocab-append-path dup [ (vocab-file-contents) ] when ;
MEMO: vocab-file-contents ( vocab name -- seq )
vocab-append-path dup
[ dup exists? [ utf8 file-lines ] [ drop f ] if ] when ;
: set-vocab-file-contents ( seq vocab name -- )
dupd vocab-append-path [
utf8 set-file-lines
\ (vocab-file-contents) reset-memoized
\ vocab-file-contents reset-memoized
] [
"The " swap vocab-name
" vocabulary was not loaded from the file system"
@ -261,7 +262,7 @@ MEMO: all-authors ( -- seq )
: reset-cache ( -- )
root-cache get-global clear-assoc
\ (vocab-file-contents) reset-memoized
\ vocab-file-contents reset-memoized
\ all-vocabs-seq reset-memoized
\ all-authors reset-memoized
\ all-tags reset-memoized ;