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
							parent
							
								
									507dac7599
								
							
						
					
					
						commit
						7327b8bdd4
					
				| 
						 | 
				
			
			@ -1 +0,0 @@
 | 
			
		|||
Slava Pestov
 | 
			
		||||
| 
						 | 
				
			
			@ -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 ;
 | 
			
		||||
| 
						 | 
				
			
			@ -1 +0,0 @@
 | 
			
		|||
Loading vocabularies and batching errors
 | 
			
		||||
| 
						 | 
				
			
			@ -3,7 +3,7 @@
 | 
			
		|||
USING: accessors arrays assocs combinators.short-circuit fry
 | 
			
		||||
io.directories io.files io.files.types io.pathnames kernel make
 | 
			
		||||
memoize namespaces sequences sorting splitting vocabs sets
 | 
			
		||||
vocabs.loader vocabs.metadata vocabs.errors ;
 | 
			
		||||
vocabs.loader vocabs.metadata ;
 | 
			
		||||
IN: vocabs.hierarchy
 | 
			
		||||
 | 
			
		||||
TUPLE: vocab-prefix name ;
 | 
			
		||||
| 
						 | 
				
			
			@ -133,22 +133,22 @@ PRIVATE>
 | 
			
		|||
: disk-vocabs-in-root ( root -- seq )
 | 
			
		||||
    "" disk-vocabs-in-root/prefix ;
 | 
			
		||||
 | 
			
		||||
: (load-from-root) ( root prefix -- failures )
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
: vocabs-to-load ( root prefix -- seq )
 | 
			
		||||
    disk-vocabs-in-root/prefix
 | 
			
		||||
    [ don't-load? ] reject no-prefixes
 | 
			
		||||
    require-all ;
 | 
			
		||||
    [ don't-load? ] reject no-prefixes ;
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
: load-from-root ( root prefix -- )
 | 
			
		||||
    (load-from-root) load-failures. ;
 | 
			
		||||
    vocabs-to-load require-all ;
 | 
			
		||||
 | 
			
		||||
: load-root ( root -- )
 | 
			
		||||
    "" load-from-root ;
 | 
			
		||||
 | 
			
		||||
: (load) ( prefix -- failures )
 | 
			
		||||
    [ vocab-roots get ] dip '[ _ (load-from-root) ] map concat ;
 | 
			
		||||
 | 
			
		||||
: load ( prefix -- )
 | 
			
		||||
    (load) load-failures. ;
 | 
			
		||||
    [ vocab-roots get ] dip '[ _ load-from-root ] each ;
 | 
			
		||||
 | 
			
		||||
: load-all ( -- )
 | 
			
		||||
    "" load ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -2,8 +2,7 @@
 | 
			
		|||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: accessors assocs checksums checksums.crc32
 | 
			
		||||
combinators.short-circuit io.encodings.utf8 io.files kernel
 | 
			
		||||
namespaces sequences sets source-files vocabs vocabs.errors
 | 
			
		||||
vocabs.loader ;
 | 
			
		||||
namespaces sequences sets source-files vocabs vocabs.loader ;
 | 
			
		||||
FROM: namespaces => set ;
 | 
			
		||||
IN: vocabs.refresh
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -72,10 +71,9 @@ SYMBOL: changed-vocabs
 | 
			
		|||
    [
 | 
			
		||||
        union
 | 
			
		||||
        [ mark-unchanged-vocabs ]
 | 
			
		||||
        [ require-all load-failures. ] bi
 | 
			
		||||
        [ require-all ] bi
 | 
			
		||||
    ] 2bi ;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
: refresh ( prefix -- ) to-refresh do-refresh ;
 | 
			
		||||
 | 
			
		||||
: refresh-all ( -- ) "" refresh ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -68,13 +68,18 @@ GENERIC: errors-changed ( observer -- )
 | 
			
		|||
 | 
			
		||||
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 -- )
 | 
			
		||||
    [
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -133,6 +133,9 @@ PRIVATE>
 | 
			
		|||
 | 
			
		||||
SYMBOL: blacklist
 | 
			
		||||
 | 
			
		||||
: require-all ( vocabs -- )
 | 
			
		||||
    V{ } clone blacklist [ [ require ] each ] with-variable ;
 | 
			
		||||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
: add-to-blacklist ( error vocab -- )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,15 +1,44 @@
 | 
			
		|||
! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: accessors assocs benchmark bootstrap.stage2 command-line
 | 
			
		||||
compiler.errors generic help.html help.lint io io.directories
 | 
			
		||||
io.encodings.utf8 io.files kernel locals mason.common namespaces
 | 
			
		||||
parser.notes sequences sets sorting source-files.errors system
 | 
			
		||||
tools.errors tools.test tools.time vocabs.errors
 | 
			
		||||
vocabs.hierarchy vocabs.refresh words ;
 | 
			
		||||
compiler.errors continuations debugger fry generic help.html
 | 
			
		||||
help.lint io io.directories io.encodings.utf8 io.files io.styles
 | 
			
		||||
kernel locals mason.common namespaces parser.notes sequences
 | 
			
		||||
sets sorting source-files.errors system tools.errors tools.test
 | 
			
		||||
tools.time vocabs vocabs.hierarchy.private vocabs.loader
 | 
			
		||||
vocabs.refresh words ;
 | 
			
		||||
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 ( -- )
 | 
			
		||||
    "" (load)
 | 
			
		||||
    "" load-no-restarts
 | 
			
		||||
    [ keys load-all-vocabs-file to-file ]
 | 
			
		||||
    [ load-all-errors-file utf8 [ load-failures. ] with-file-writer ]
 | 
			
		||||
    bi ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue