compiler.units: more use of hash-sets.
							parent
							
								
									b8097f9221
								
							
						
					
					
						commit
						bc18b2cd29
					
				| 
						 | 
				
			
			@ -18,10 +18,10 @@ TUPLE: redefine-error def ;
 | 
			
		|||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
: add-once ( key assoc -- )
 | 
			
		||||
    2dup key? [ over redefine-error ] when conjoin ;
 | 
			
		||||
: add-once ( key set -- )
 | 
			
		||||
    2dup in? [ over redefine-error ] when adjoin ;
 | 
			
		||||
 | 
			
		||||
: (remember-definition) ( definition loc assoc -- )
 | 
			
		||||
: (remember-definition) ( definition loc set -- )
 | 
			
		||||
    [ over set-where ] dip add-once ;
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
| 
						 | 
				
			
			@ -30,16 +30,16 @@ PRIVATE>
 | 
			
		|||
    new-definitions get first (remember-definition) ;
 | 
			
		||||
 | 
			
		||||
: fake-definition ( definition -- )
 | 
			
		||||
    old-definitions get [ delete-at ] with each ;
 | 
			
		||||
    old-definitions get [ delete ] with each ;
 | 
			
		||||
 | 
			
		||||
: remember-class ( class loc -- )
 | 
			
		||||
    [ dup new-definitions get first key? [ dup redefine-error ] when ] dip
 | 
			
		||||
    [ dup new-definitions get first in? [ dup redefine-error ] when ] dip
 | 
			
		||||
    new-definitions get second (remember-definition) ;
 | 
			
		||||
 | 
			
		||||
: forward-reference? ( word -- ? )
 | 
			
		||||
    dup old-definitions get assoc-stack
 | 
			
		||||
    [ new-definitions get assoc-stack not ]
 | 
			
		||||
    [ drop f ] if ;
 | 
			
		||||
    dup old-definitions get [ in? ] with any? [
 | 
			
		||||
        new-definitions get [ in? ] with any? not
 | 
			
		||||
    ] [ drop f ] if ;
 | 
			
		||||
 | 
			
		||||
SYMBOL: compiler-impl
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -81,7 +81,7 @@ M: f process-forgotten-words drop ;
 | 
			
		|||
: without-optimizer ( quot -- )
 | 
			
		||||
    [ f compiler-impl ] dip with-variable ; inline
 | 
			
		||||
 | 
			
		||||
: <definitions> ( -- pair ) { H{ } H{ } } [ clone ] map ;
 | 
			
		||||
: <definitions> ( -- pair ) { HS{ } HS{ } } [ clone ] map ;
 | 
			
		||||
 | 
			
		||||
SYMBOL: definition-observers
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -122,8 +122,8 @@ M: object always-bump-effect-counter? drop f ;
 | 
			
		|||
: updated-definitions ( -- set )
 | 
			
		||||
    HS{ } clone
 | 
			
		||||
    forgotten-definitions get union!
 | 
			
		||||
    new-definitions get first keys over adjoin-all
 | 
			
		||||
    new-definitions get second keys over adjoin-all
 | 
			
		||||
    new-definitions get first union!
 | 
			
		||||
    new-definitions get second union!
 | 
			
		||||
    changed-definitions get union!
 | 
			
		||||
    maybe-changed get union!
 | 
			
		||||
    dup changed-vocabs over adjoin-all ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -5,6 +5,7 @@ compiler.units continuations definitions effects io
 | 
			
		|||
io.encodings.utf8 io.files kernel lexer math.parser namespaces
 | 
			
		||||
parser.notes quotations sequences sets slots source-files
 | 
			
		||||
vectors vocabs vocabs.parser words words.symbol ;
 | 
			
		||||
FROM: sets => members ;
 | 
			
		||||
IN: parser
 | 
			
		||||
 | 
			
		||||
: location ( -- loc )
 | 
			
		||||
| 
						 | 
				
			
			@ -162,8 +163,8 @@ print-use-hook [ [ ] ] initialize
 | 
			
		|||
: parsing-file ( file -- )
 | 
			
		||||
    parser-quiet? get [ drop ] [ "Loading " write print flush ] if ;
 | 
			
		||||
 | 
			
		||||
: filter-moved ( assoc1 assoc2 -- seq )
 | 
			
		||||
    swap assoc-diff keys [
 | 
			
		||||
: filter-moved ( set1 set2 -- seq )
 | 
			
		||||
    swap diff members [
 | 
			
		||||
        {
 | 
			
		||||
            { [ dup where dup [ first ] when file get path>> = not ] [ f ] }
 | 
			
		||||
            { [ dup reader-method? ] [ f ] }
 | 
			
		||||
| 
						 | 
				
			
			@ -172,11 +173,11 @@ print-use-hook [ [ ] ] initialize
 | 
			
		|||
        } cond nip
 | 
			
		||||
    ] filter ;
 | 
			
		||||
 | 
			
		||||
: removed-definitions ( -- assoc1 assoc2 )
 | 
			
		||||
: removed-definitions ( -- set1 set2 )
 | 
			
		||||
    new-definitions old-definitions
 | 
			
		||||
    [ get first2 assoc-union ] bi@ ;
 | 
			
		||||
    [ get first2 union ] bi@ ;
 | 
			
		||||
 | 
			
		||||
: removed-classes ( -- assoc1 assoc2 )
 | 
			
		||||
: removed-classes ( -- set1 set2 )
 | 
			
		||||
    new-definitions old-definitions
 | 
			
		||||
    [ get second ] bi@ ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -2,8 +2,9 @@
 | 
			
		|||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: accessors arrays assocs checksums checksums.crc32
 | 
			
		||||
compiler.units continuations definitions io.encodings.utf8
 | 
			
		||||
io.files io.pathnames kernel namespaces sequences
 | 
			
		||||
io.files io.pathnames kernel namespaces sequences sets
 | 
			
		||||
source-files.errors strings words ;
 | 
			
		||||
FROM: namespaces => set ;
 | 
			
		||||
IN: source-files
 | 
			
		||||
 | 
			
		||||
SYMBOL: source-files
 | 
			
		||||
| 
						 | 
				
			
			@ -47,14 +48,14 @@ M: pathname where string>> 1 2array ;
 | 
			
		|||
 | 
			
		||||
: forget-source ( path -- )
 | 
			
		||||
    source-files get delete-at*
 | 
			
		||||
    [ definitions>> [ keys forget-all ] each ] [ drop ] if ;
 | 
			
		||||
    [ definitions>> [ members forget-all ] each ] [ drop ] if ;
 | 
			
		||||
 | 
			
		||||
M: pathname forget*
 | 
			
		||||
    string>> forget-source ;
 | 
			
		||||
 | 
			
		||||
: rollback-source-file ( file -- )
 | 
			
		||||
    [
 | 
			
		||||
        new-definitions get [ assoc-union ] 2map
 | 
			
		||||
        new-definitions get [ union ] 2map
 | 
			
		||||
    ] change-definitions drop ;
 | 
			
		||||
 | 
			
		||||
SYMBOL: file
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue