diff --git a/core/vocabs/loader/loader-tests.factor b/core/vocabs/loader/loader-tests.factor index 1191594fe5..45b0d6b019 100755 --- a/core/vocabs/loader/loader-tests.factor +++ b/core/vocabs/loader/loader-tests.factor @@ -110,6 +110,8 @@ IN: vocabs.loader.tests ] with-compilation-unit ] unit-test +[ ] [ "vocabs.loader.test.b" changed-vocab ] unit-test + [ ] [ "vocabs.loader.test.b" refresh ] unit-test [ 3 ] [ "count-me" get-global ] unit-test diff --git a/extra/tools/vocabs/monitor/monitor.factor b/extra/tools/vocabs/monitor/monitor.factor index 867c3b2903..826d410480 100755 --- a/extra/tools/vocabs/monitor/monitor.factor +++ b/extra/tools/vocabs/monitor/monitor.factor @@ -10,8 +10,7 @@ IN: tools.vocabs.monitor { { CHAR: / CHAR: . } { CHAR: \\ CHAR: . } } substitute ; : path>vocab-name ( path -- vocab ) - dup ".factor" tail? [ parent-directory ] when - ; + dup ".factor" tail? [ parent-directory ] when ; : chop-vocab-root ( path -- path' ) "resource:" prepend-path (normalize-path) @@ -23,10 +22,6 @@ IN: tools.vocabs.monitor : path>vocab ( path -- vocab ) chop-vocab-root path>vocab-name vocab-dir>vocab-name ; -: changed-vocab ( vocab -- ) - dup vocab - [ dup changed-vocabs get-global set-at ] [ drop ] if ; - : monitor-thread ( monitor -- ) #! On OS X, monitors give us the full path, so we chop it #! off if its there. diff --git a/extra/tools/vocabs/vocabs.factor b/extra/tools/vocabs/vocabs.factor index 825d2a6329..211b396c50 100755 --- a/extra/tools/vocabs/vocabs.factor +++ b/extra/tools/vocabs/vocabs.factor @@ -32,43 +32,6 @@ IN: tools.vocabs [ vocab-tests % ] tri ] { } make ; -: source-modified? ( path -- ? ) - dup source-files get at [ - dup source-file-path - dup exists? [ - utf8 file-lines lines-crc32 - swap source-file-checksum = not - ] [ - 2drop f - ] if - ] [ - exists? - ] ?if ; - -: modified ( seq quot -- seq ) - [ dup ] swap compose { } map>assoc - [ nip ] assoc-subset - [ nip source-modified? ] assoc-subset keys ; inline - -: modified-sources ( vocabs -- seq ) - [ vocab-source-path ] modified ; - -: 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 filter-changed - [ modified-sources ] [ modified-docs ] bi ; - : vocab-heading. ( vocab -- ) nl "==== " write @@ -95,12 +58,87 @@ SYMBOL: failures failures get ] with-compiler-errors ; -: do-refresh ( modified-sources modified-docs -- ) +: source-modified? ( path -- ? ) + dup source-files get at [ + dup source-file-path + dup exists? [ + utf8 file-lines lines-crc32 + swap source-file-checksum = not + ] [ + 2drop f + ] if + ] [ + exists? + ] ?if ; + +SYMBOL: changed-vocabs + +[ f changed-vocabs set-global ] "tools.vocabs" add-init-hook + +: changed-vocab ( vocab -- ) + dup vocab + [ dup changed-vocabs get-global set-at ] [ drop ] if ; + +: unchanged-vocab ( vocab -- ) + changed-vocabs get-global delete-at ; + +: unchanged-vocabs ( vocabs -- ) + [ unchanged-vocab ] each ; + +: filter-changed ( vocabs -- vocabs' ) + changed-vocabs get [ + [ key? ] curry subset + ] when* ; + +SYMBOL: modified-sources +SYMBOL: modified-docs + +: (to-refresh) ( vocab variable loaded? path -- ) + dup [ + swap [ + pick changed-vocabs get key? [ + source-modified? [ get push ] [ 2drop ] if + ] [ 3drop ] if + ] [ drop get push ] if + ] [ 2drop 2drop ] if ; + +: to-refresh ( prefix -- modified-sources modified-docs unchanged ) + [ + V{ } clone modified-sources set + V{ } clone modified-docs set + + child-vocabs [ + [ + [ + [ modified-sources ] + [ vocab-source-loaded? ] + [ vocab-source-path ] + tri (to-refresh) + ] [ + [ modified-docs ] + [ vocab-docs-loaded? ] + [ vocab-docs-path ] + tri (to-refresh) + ] bi + ] each + + modified-sources get + modified-docs get + ] + [ modified-sources get modified-docs get append swap seq-diff ] bi + ] with-scope ; + +: do-refresh ( modified-sources modified-docs unchanged -- ) + unchanged-vocabs [ [ [ f swap set-vocab-source-loaded? ] each ] [ [ f swap set-vocab-docs-loaded? ] each ] bi* ] - [ append prune require-all load-failures. ] 2bi ; + [ + append prune + [ unchanged-vocabs ] + [ require-all load-failures. ] bi + ] 2bi ; : refresh ( prefix -- ) to-refresh do-refresh ;