Working on faster refresh-all

extra/tools/vocabs/monitor/monitor.factor

@@ -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
+: vocab-dir>vocab-name ( path -- vocab )
-! cache
+    left-trim-separators right-trim-separators
-SYMBOL: vocab-monitor
+    { { CHAR: / CHAR: . } { CHAR: \\ CHAR: . } } substitute ;
 
-: monitor-thread ( -- )
+: path>vocab-name ( path -- vocab )
-    vocab-monitor get-global
+    dup ".factor" tail? [ parent-directory ] when
-    next-change 2drop
+    dup [ vocab-dir>vocab-name ] when ;
-    t sources-changed? set-global reset-cache ;
 
-: 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
+        vocab-roots get [ start-monitor-thread ] each
-        [ monitor-thread t ] "Vocabulary monitor" spawn-server drop
+        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

extra/tools/vocabs/vocabs.factor

@@ -21,15 +21,15 @@ IN: tools.vocabs
 
 : vocab-tests ( vocab -- tests )
     [
-        dup vocab-tests-file [ , ] when*
+        [ vocab-tests-file [ , ] when* ]
-        vocab-tests-dir [ % ] when*
+        [ vocab-tests-dir [ % ] when* ] bi
     ] { } make ;
 
 : vocab-files ( vocab -- seq )
     [
-        dup vocab-source-path [ , ] when*
+        [ vocab-source-path [ , ] when* ]
-        dup vocab-docs-path [ , ] when*
+        [ vocab-docs-path [ , ] when* ]
-        vocab-tests %
+        [ 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
+    child-vocabs filter-changed
-    dup modified-sources swap modified-docs ;
+    [ 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.
+    [ first vocab-heading. ] [ second print-error ] bi ;
-    dup second print-error
-    drop ;
 
 : 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 ]
-    [ f swap set-vocab-source-loaded? ] each
+        [ [ f swap set-vocab-docs-loaded? ] each ] bi*
-    append prune require-all load-failures. ;
+    ]
+    [ 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
+MEMO: vocab-file-contents ( vocab name -- seq )
-
+    vocab-append-path dup
-: refresh-all ( -- )
+    [ dup exists? [ utf8 file-lines ] [ drop f ] if ] when ;
-    "" 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 ;
 
 : 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 ;