vocabs.refresh.monitor: spin off new monitor threads when add-vocab-root is called. Fixes a problem where depending on the order of startup hooks, refresh-all would sometimes be broken for custom vocab roots

db4
Slava Pestov 2010-05-31 20:14:07 -04:00
parent d8ce35aacc
commit f78bbb865e
2 changed files with 72 additions and 66 deletions

View File

@ -1,59 +1,58 @@
! Copyright (C) 2008, 2009 Slava Pestov. ! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs command-line concurrency.messaging USING: accessors assocs command-line concurrency.messaging
continuations init io.backend io.files io.monitors io.pathnames continuations init io.backend io.files io.monitors io.pathnames
kernel namespaces sequences sets splitting threads kernel namespaces sequences sets splitting threads fry
tr vocabs vocabs.loader vocabs.refresh vocabs.cache ; tr vocabs vocabs.loader vocabs.refresh vocabs.cache ;
IN: vocabs.refresh.monitor IN: vocabs.refresh.monitor
TR: convert-separators "/\\" ".." ; TR: convert-separators "/\\" ".." ;
: vocab-dir>vocab-name ( path -- vocab ) : vocab-dir>vocab-name ( path -- vocab )
trim-head-separators trim-head-separators
trim-tail-separators trim-tail-separators
convert-separators ; convert-separators ;
: path>vocab-name ( path -- vocab ) : path>vocab-name ( path -- vocab )
dup ".factor" tail? [ parent-directory ] when ; dup ".factor" tail? [ parent-directory ] when ;
: chop-vocab-root ( path -- path' ) : chop-vocab-root ( path -- path' )
"resource:" prepend-path normalize-path "resource:" prepend-path normalize-path
dup vocab-roots get dup vocab-roots get
[ normalize-path ] map [ normalize-path ] map
[ head? ] with find nip [ head? ] with find nip
?head drop ; ?head drop ;
: path>vocab ( path -- vocab ) : path>vocab ( path -- vocab )
chop-vocab-root path>vocab-name vocab-dir>vocab-name ; chop-vocab-root path>vocab-name vocab-dir>vocab-name ;
: monitor-loop ( -- ) : monitor-loop ( monitor -- )
#! On OS X, monitors give us the full path, so we chop it #! On OS X, monitors give us the full path, so we chop it
#! off if its there. #! off if its there.
receive path>> path>vocab changed-vocab [ next-change path>> path>vocab changed-vocab reset-cache ]
reset-cache [ monitor-loop ]
monitor-loop ; bi ;
: add-monitor-for-path ( path -- ) : (start-vocab-monitor) ( vocab-root -- )
dup exists? [ t my-mailbox (monitor) ] when drop ; dup exists?
[ [ t <monitor> monitor-loop ] with-monitors ] [ drop ] if ;
: monitor-thread ( -- )
[ : start-vocab-monitor ( vocab-root -- )
[ [ '[ [ _ (start-vocab-monitor) ] ignore-errors ] ]
vocab-roots get [ add-monitor-for-path ] each [ "Root monitor: " prepend ]
bi spawn drop ;
H{ } clone changed-vocabs set-global
vocabs [ changed-vocab ] each : init-vocab-monitor ( -- )
H{ } clone changed-vocabs set-global
monitor-loop vocabs [ changed-vocab ] each ;
] with-monitors
] ignore-errors ; [
"-no-monitors" (command-line) member? [
: start-monitor-thread ( -- ) [ drop ] add-vocab-root-hook set-global
#! Silently ignore errors during monitor creation since f changed-vocabs set-global
#! monitors are not supported on all platforms. ] [
[ monitor-thread ] "Vocabulary monitor" spawn drop ; init-vocab-monitor
vocab-roots get [ start-vocab-monitor ] each
[ [ start-vocab-monitor ] add-vocab-root-hook set-global
"-no-monitors" (command-line) member? ] if
[ start-monitor-thread ] unless ] "vocabs.refresh.monitor" add-startup-hook
] "vocabs.refresh.monitor" add-startup-hook

View File

@ -8,15 +8,22 @@ IN: vocabs.loader
SYMBOL: vocab-roots SYMBOL: vocab-roots
V{ SYMBOL: add-vocab-root-hook
"resource:core"
"resource:basis" [
"resource:extra" V{
"resource:work" "resource:core"
} clone vocab-roots set-global "resource:basis"
"resource:extra"
"resource:work"
} clone vocab-roots set-global
[ drop ] add-vocab-root-hook set-global
] "vocabs.loader" add-startup-hook
: add-vocab-root ( root -- ) : add-vocab-root ( root -- )
vocab-roots get adjoin ; [ vocab-roots get adjoin ]
[ add-vocab-root-hook get-global call( root -- ) ] bi ;
SYMBOL: root-cache SYMBOL: root-cache