vocabs.loader: make require-all throw restarts.

We only want to catch the restarts in mason, so make a special
load-no-restarts that will catch the failures and print them out
the same way it worked before.
db4
John Benediktsson 2015-07-20 17:34:24 -07:00
parent 507dac7599
commit 7327b8bdd4
8 changed files with 58 additions and 60 deletions

View File

@ -1 +0,0 @@
Slava Pestov

View File

@ -1,35 +0,0 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs continuations debugger io io.styles kernel
namespaces sequences vocabs vocabs.loader ;
IN: vocabs.errors
<PRIVATE
: vocab-heading. ( vocab -- )
nl
"==== " write
[ vocab-name ] [ lookup-vocab write-object ] bi ":" print
nl ;
: load-error. ( triple -- )
[ first vocab-heading. ] [ second print-error ] bi ;
SYMBOL: failures
PRIVATE>
: load-failures. ( failures -- )
[ load-error. nl ] each ;
: require-all ( vocabs -- failures )
[
V{ } clone blacklist set
V{ } clone failures set
[
[ require ]
[ swap vocab-name failures get set-at ]
recover
] each
failures get
] with-scope ;

View File

@ -1 +0,0 @@
Loading vocabularies and batching errors

View File

@ -3,7 +3,7 @@
USING: accessors arrays assocs combinators.short-circuit fry USING: accessors arrays assocs combinators.short-circuit fry
io.directories io.files io.files.types io.pathnames kernel make io.directories io.files io.files.types io.pathnames kernel make
memoize namespaces sequences sorting splitting vocabs sets memoize namespaces sequences sorting splitting vocabs sets
vocabs.loader vocabs.metadata vocabs.errors ; vocabs.loader vocabs.metadata ;
IN: vocabs.hierarchy IN: vocabs.hierarchy
TUPLE: vocab-prefix name ; TUPLE: vocab-prefix name ;
@ -133,22 +133,22 @@ PRIVATE>
: disk-vocabs-in-root ( root -- seq ) : disk-vocabs-in-root ( root -- seq )
"" disk-vocabs-in-root/prefix ; "" disk-vocabs-in-root/prefix ;
: (load-from-root) ( root prefix -- failures ) <PRIVATE
: vocabs-to-load ( root prefix -- seq )
disk-vocabs-in-root/prefix disk-vocabs-in-root/prefix
[ don't-load? ] reject no-prefixes [ don't-load? ] reject no-prefixes ;
require-all ;
PRIVATE>
: load-from-root ( root prefix -- ) : load-from-root ( root prefix -- )
(load-from-root) load-failures. ; vocabs-to-load require-all ;
: load-root ( root -- ) : load-root ( root -- )
"" load-from-root ; "" load-from-root ;
: (load) ( prefix -- failures )
[ vocab-roots get ] dip '[ _ (load-from-root) ] map concat ;
: load ( prefix -- ) : load ( prefix -- )
(load) load-failures. ; [ vocab-roots get ] dip '[ _ load-from-root ] each ;
: load-all ( -- ) : load-all ( -- )
"" load ; "" load ;

View File

@ -2,8 +2,7 @@
! 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
combinators.short-circuit io.encodings.utf8 io.files kernel combinators.short-circuit io.encodings.utf8 io.files kernel
namespaces sequences sets source-files vocabs vocabs.errors namespaces sequences sets source-files vocabs vocabs.loader ;
vocabs.loader ;
FROM: namespaces => set ; FROM: namespaces => set ;
IN: vocabs.refresh IN: vocabs.refresh
@ -72,10 +71,9 @@ SYMBOL: changed-vocabs
[ [
union union
[ mark-unchanged-vocabs ] [ mark-unchanged-vocabs ]
[ require-all load-failures. ] bi [ require-all ] bi
] 2bi ; ] 2bi ;
: refresh ( prefix -- ) to-refresh do-refresh ; : refresh ( prefix -- ) to-refresh do-refresh ;
: refresh-all ( -- ) "" refresh ; : refresh-all ( -- ) "" refresh ;

View File

@ -68,13 +68,18 @@ GENERIC: errors-changed ( observer -- )
SYMBOL: error-observers SYMBOL: error-observers
[ V{ } clone error-observers set-global ] "source-files.errors" add-startup-hook [
V{ } clone error-observers set-global
] "source-files.errors" add-startup-hook
: add-error-observer ( observer -- ) error-observers get push ; : add-error-observer ( observer -- )
error-observers get push ;
: remove-error-observer ( observer -- ) error-observers get remove-eq! drop ; : remove-error-observer ( observer -- )
error-observers get remove-eq! drop ;
: notify-error-observers ( -- ) error-observers get [ errors-changed ] each ; : notify-error-observers ( -- )
error-observers get [ errors-changed ] each ;
: delete-file-errors ( seq file type -- ) : delete-file-errors ( seq file type -- )
[ [

View File

@ -133,6 +133,9 @@ PRIVATE>
SYMBOL: blacklist SYMBOL: blacklist
: require-all ( vocabs -- )
V{ } clone blacklist [ [ require ] each ] with-variable ;
<PRIVATE <PRIVATE
: add-to-blacklist ( error vocab -- ) : add-to-blacklist ( error vocab -- )

View File

@ -1,15 +1,44 @@
! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov. ! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs benchmark bootstrap.stage2 command-line USING: accessors assocs benchmark bootstrap.stage2 command-line
compiler.errors generic help.html help.lint io io.directories compiler.errors continuations debugger fry generic help.html
io.encodings.utf8 io.files kernel locals mason.common namespaces help.lint io io.directories io.encodings.utf8 io.files io.styles
parser.notes sequences sets sorting source-files.errors system kernel locals mason.common namespaces parser.notes sequences
tools.errors tools.test tools.time vocabs.errors sets sorting source-files.errors system tools.errors tools.test
vocabs.hierarchy vocabs.refresh words ; tools.time vocabs vocabs.hierarchy.private vocabs.loader
vocabs.refresh words ;
IN: mason.test IN: mason.test
: vocab-heading. ( vocab -- )
nl
"==== " write
[ vocab-name ] [ lookup-vocab write-object ] bi ":" print
nl ;
: load-error. ( triple -- )
[ first vocab-heading. ] [ second print-error ] bi ;
: load-failures. ( failures -- ) [ load-error. nl ] each ;
: require-all-no-restarts ( vocabs -- failures )
V{ } clone blacklist [
V{ } clone [
'[
[ require ]
[ swap vocab-name _ set-at ] recover
] each
] keep
] with-variable ;
: load-from-root-no-restarts ( root prefix -- failures )
vocabs-to-load require-all-no-restarts ;
: load-no-restarts ( prefix -- failures )
[ vocab-roots get ] dip
'[ _ load-from-root-no-restarts ] map concat ;
: do-load ( -- ) : do-load ( -- )
"" (load) "" load-no-restarts
[ keys load-all-vocabs-file to-file ] [ keys load-all-vocabs-file to-file ]
[ load-all-errors-file utf8 [ load-failures. ] with-file-writer ] [ load-all-errors-file utf8 [ load-failures. ] with-file-writer ]
bi ; bi ;