compiler.units: more use of hash-sets.

db4
John Benediktsson 2013-03-10 18:04:37 -07:00
parent b8097f9221
commit bc18b2cd29
3 changed files with 21 additions and 19 deletions

View File

@ -18,10 +18,10 @@ TUPLE: redefine-error def ;
<PRIVATE <PRIVATE
: add-once ( key assoc -- ) : add-once ( key set -- )
2dup key? [ over redefine-error ] when conjoin ; 2dup in? [ over redefine-error ] when adjoin ;
: (remember-definition) ( definition loc assoc -- ) : (remember-definition) ( definition loc set -- )
[ over set-where ] dip add-once ; [ over set-where ] dip add-once ;
PRIVATE> PRIVATE>
@ -30,16 +30,16 @@ PRIVATE>
new-definitions get first (remember-definition) ; new-definitions get first (remember-definition) ;
: fake-definition ( definition -- ) : fake-definition ( definition -- )
old-definitions get [ delete-at ] with each ; old-definitions get [ delete ] with each ;
: remember-class ( class loc -- ) : 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) ; new-definitions get second (remember-definition) ;
: forward-reference? ( word -- ? ) : forward-reference? ( word -- ? )
dup old-definitions get assoc-stack dup old-definitions get [ in? ] with any? [
[ new-definitions get assoc-stack not ] new-definitions get [ in? ] with any? not
[ drop f ] if ; ] [ drop f ] if ;
SYMBOL: compiler-impl SYMBOL: compiler-impl
@ -81,7 +81,7 @@ M: f process-forgotten-words drop ;
: without-optimizer ( quot -- ) : without-optimizer ( quot -- )
[ f compiler-impl ] dip with-variable ; inline [ f compiler-impl ] dip with-variable ; inline
: <definitions> ( -- pair ) { H{ } H{ } } [ clone ] map ; : <definitions> ( -- pair ) { HS{ } HS{ } } [ clone ] map ;
SYMBOL: definition-observers SYMBOL: definition-observers
@ -122,8 +122,8 @@ M: object always-bump-effect-counter? drop f ;
: updated-definitions ( -- set ) : updated-definitions ( -- set )
HS{ } clone HS{ } clone
forgotten-definitions get union! forgotten-definitions get union!
new-definitions get first keys over adjoin-all new-definitions get first union!
new-definitions get second keys over adjoin-all new-definitions get second union!
changed-definitions get union! changed-definitions get union!
maybe-changed get union! maybe-changed get union!
dup changed-vocabs over adjoin-all ; dup changed-vocabs over adjoin-all ;

View File

@ -5,6 +5,7 @@ compiler.units continuations definitions effects io
io.encodings.utf8 io.files kernel lexer math.parser namespaces io.encodings.utf8 io.files kernel lexer math.parser namespaces
parser.notes quotations sequences sets slots source-files parser.notes quotations sequences sets slots source-files
vectors vocabs vocabs.parser words words.symbol ; vectors vocabs vocabs.parser words words.symbol ;
FROM: sets => members ;
IN: parser IN: parser
: location ( -- loc ) : location ( -- loc )
@ -162,8 +163,8 @@ print-use-hook [ [ ] ] initialize
: parsing-file ( file -- ) : parsing-file ( file -- )
parser-quiet? get [ drop ] [ "Loading " write print flush ] if ; parser-quiet? get [ drop ] [ "Loading " write print flush ] if ;
: filter-moved ( assoc1 assoc2 -- seq ) : filter-moved ( set1 set2 -- seq )
swap assoc-diff keys [ swap diff members [
{ {
{ [ dup where dup [ first ] when file get path>> = not ] [ f ] } { [ dup where dup [ first ] when file get path>> = not ] [ f ] }
{ [ dup reader-method? ] [ f ] } { [ dup reader-method? ] [ f ] }
@ -172,11 +173,11 @@ print-use-hook [ [ ] ] initialize
} cond nip } cond nip
] filter ; ] filter ;
: removed-definitions ( -- assoc1 assoc2 ) : removed-definitions ( -- set1 set2 )
new-definitions old-definitions 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 new-definitions old-definitions
[ get second ] bi@ ; [ get second ] bi@ ;

View File

@ -2,8 +2,9 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs checksums checksums.crc32 USING: accessors arrays assocs checksums checksums.crc32
compiler.units continuations definitions io.encodings.utf8 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 ; source-files.errors strings words ;
FROM: namespaces => set ;
IN: source-files IN: source-files
SYMBOL: source-files SYMBOL: source-files
@ -47,14 +48,14 @@ M: pathname where string>> 1 2array ;
: forget-source ( path -- ) : forget-source ( path -- )
source-files get delete-at* source-files get delete-at*
[ definitions>> [ keys forget-all ] each ] [ drop ] if ; [ definitions>> [ members forget-all ] each ] [ drop ] if ;
M: pathname forget* M: pathname forget*
string>> forget-source ; string>> forget-source ;
: rollback-source-file ( file -- ) : rollback-source-file ( file -- )
[ [
new-definitions get [ assoc-union ] 2map new-definitions get [ union ] 2map
] change-definitions drop ; ] change-definitions drop ;
SYMBOL: file SYMBOL: file