vocabs.refresh: Trying to clean up some vocabs code.

diff --git a/basis/vocabs/refresh/refresh-tests.factor b/basis/vocabs/refresh/refresh-tests.factor
index ad8f005398df49291a91c0480cbbf0af984c7782..8d397aa1afe226b816e8ff4935b70fa8209a1851 100644 (file)
--- a/basis/vocabs/refresh/refresh-tests.factor
+++ b/basis/vocabs/refresh/refresh-tests.factor
@@ -4,6 +4,6 @@ USING: vocabs.refresh tools.test continuations namespaces ;
 [ ] [
     changed-vocabs get-global
     f changed-vocabs set-global
-    [ t ] [ "kernel" changed-vocab? ] unit-test
+    [ t ] [ "kernel" changed-vocab-by-name? ] unit-test
     [ "kernel" changed-vocab ] [ changed-vocabs set-global ] [ ] cleanup
 ] unit-test

diff --git a/basis/vocabs/refresh/refresh.factor b/basis/vocabs/refresh/refresh.factor
index 02e3779cd472b9f818f976f685492f6dbe9264dd..e9ecc92cc0643c3d5aea66c7096c9544af8aa9eb 100644 (file)
--- a/basis/vocabs/refresh/refresh.factor
+++ b/basis/vocabs/refresh/refresh.factor
@@ -1,8 +1,9 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs checksums checksums.crc32
-io.encodings.utf8 io.files kernel namespaces sequences sets
-source-files vocabs vocabs.errors vocabs.loader ;
+combinators.short-circuit io.encodings.utf8 io.files kernel
+namespaces sequences sets source-files vocabs vocabs.errors
+vocabs.loader ;
 FROM: namespaces => set ;
 IN: vocabs.refresh
 
@@ -25,68 +26,56 @@ SYMBOL: changed-vocabs
     dup lookup-vocab changed-vocabs get and
     [ dup changed-vocabs get set-at ] [ drop ] if ;
 
-: unchanged-vocab ( vocab -- )
+: mark-unchanged-vocab  ( vocab-name -- )
     changed-vocabs get delete-at ;
 
-: unchanged-vocabs ( vocabs -- )
-    [ unchanged-vocab ] each ;
+: mark-unchanged-vocabs  ( vocab-names -- )
+    [ mark-unchanged-vocab ] each ;
 
-: changed-vocab? ( vocab -- ? )
+: changed-vocab-by-name? ( vocab -- ? )
     changed-vocabs get [ key? ] [ drop t ] if* ;
 
-: filter-changed ( vocabs -- vocabs' )
-    [ changed-vocab? ] filter ;
+: (to-refresh) ( vocab-name loaded? path -- ? )
+    [
+        swap [
+            swap changed-vocab-by-name? [
+                source-modified?
+            ] [ drop f ] if
+        ] [ 2drop t ] if
+    ] [ 2drop f ] if* ;
 
-SYMBOL: modified-sources
-SYMBOL: modified-docs
+: vocab-source-modified? ( vocab-name -- ? )
+    [ ]
+    [ lookup-vocab source-loaded?>> ]
+    [ vocab-source-path ] tri (to-refresh) ;
 
-: (to-refresh) ( vocab variable loaded? path -- )
-    dup [
-        swap [
-            pick changed-vocab? [
-                source-modified? [ get push ] [ 2drop ] if
-            ] [ 3drop ] if
-        ] [ drop get push ] if
-    ] [ 4drop ] if ;
+: vocab-docs-modified? ( vocab-name -- ? )
+    [ ]
+    [ lookup-vocab docs-loaded?>> ]
+    [ vocab-docs-path ] tri (to-refresh) ;
 
 : to-refresh ( prefix -- modified-sources modified-docs unchanged )
+    child-vocabs [ ".private" tail? ] reject
     [
-        V{ } clone modified-sources set
-        V{ } clone modified-docs set
-
-        child-vocabs [ ".private" tail? ] reject [
-            [
-                [
-                    [ modified-sources ]
-                    [ lookup-vocab source-loaded?>> ]
-                    [ vocab-source-path ]
-                    tri (to-refresh)
-                ] [
-                    [ modified-docs ]
-                    [ lookup-vocab docs-loaded?>> ]
-                    [ vocab-docs-path ]
-                    tri (to-refresh)
-                ] bi
-            ] each
-
-            modified-sources get
-            modified-docs get
-        ]
-        [ modified-docs get modified-sources get append diff ] bi
-    ] with-scope ;
+        [ [ vocab-source-modified? ] filter ]
+        [ [ vocab-docs-modified? ] filter ] bi
+    ] [
+        [ 2dup append ] dip swap diff
+    ] bi ;
 
 : do-refresh ( modified-sources modified-docs unchanged -- )
-    unchanged-vocabs
+    mark-unchanged-vocabs
     [
         [ [ lookup-vocab f >>source-loaded? drop ] each ]
         [ [ lookup-vocab f >>docs-loaded? drop ] each ] bi*
     ]
     [
         union
-        [ unchanged-vocabs ]
+        [ mark-unchanged-vocabs ]
         [ require-all load-failures. ] bi
     ] 2bi ;
 
+
 : refresh ( prefix -- ) to-refresh do-refresh ;
 
 : refresh-all ( -- ) "" refresh ;