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
							parent
							
								
									d8ce35aacc
								
							
						
					
					
						commit
						f78bbb865e
					
				| 
						 | 
					@ -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
 | 
					 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -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
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue