steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Doug Coleman 2015-06-07 16:12:20 -07:00
parent 017a030bbc
commit 1cc9b00b42
2 changed files with 34 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/vocabs/refresh/refresh-tests.factor
View File

@ -4,6 +4,6 @@ USING: vocabs.refresh tools.test continuations namespaces ;
[ ] [ [ ] [
changed-vocabs get-global changed-vocabs get-global
f changed-vocabs set-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 [ "kernel" changed-vocab ] [ changed-vocabs set-global ] [ ] cleanup
] unit-test ] unit-test

77
basis/vocabs/refresh/refresh.factor
View File

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