compiler: more use of hash-sets.
parent
1776893c36
commit
7f3f90eb8d
|
@ -4,6 +4,7 @@ USING: accessors kernel namespaces arrays sequences io words fry
|
|||
continuations vocabs assocs definitions math graphs generic
|
||||
generic.single combinators macros make source-files.errors
|
||||
combinators.short-circuit classes.algebra vocabs.loader
|
||||
sets
|
||||
|
||||
stack-checker stack-checker.dependencies stack-checker.inlining
|
||||
stack-checker.errors
|
||||
|
@ -149,10 +150,10 @@ SINGLETON: optimizing-compiler
|
|||
M: optimizing-compiler update-call-sites ( class generic -- words )
|
||||
#! Words containing call sites with inferred type 'class'
|
||||
#! which inlined a method on 'generic'
|
||||
generic-call-sites-of swap '[
|
||||
nip _ 2dup [ valid-classoid? ] both?
|
||||
generic-call-sites-of keys swap '[
|
||||
_ 2dup [ valid-classoid? ] both?
|
||||
[ classes-intersect? ] [ 2drop f ] if
|
||||
] assoc-filter keys ;
|
||||
] filter ;
|
||||
|
||||
M: optimizing-compiler recompile ( words -- alist )
|
||||
H{ } clone compiled [
|
||||
|
@ -164,10 +165,16 @@ M: optimizing-compiler recompile ( words -- alist )
|
|||
|
||||
M: optimizing-compiler to-recompile ( -- words )
|
||||
[
|
||||
changed-effects get new-words get assoc-diff outdated-effect-usages %
|
||||
changed-definitions get new-words get assoc-diff outdated-definition-usages %
|
||||
maybe-changed get new-words get assoc-diff outdated-conditional-usages %
|
||||
changed-definitions get [ drop word? ] assoc-filter 1array %
|
||||
changed-effects get new-words get diff
|
||||
outdated-effect-usages %
|
||||
|
||||
changed-definitions get new-words get diff
|
||||
outdated-definition-usages %
|
||||
|
||||
maybe-changed get new-words get diff
|
||||
outdated-conditional-usages %
|
||||
|
||||
changed-definitions get members [ word? ] filter dup zip ,
|
||||
] { } make assoc-combine keys ;
|
||||
|
||||
M: optimizing-compiler process-forgotten-words
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays assocs classes.algebra compiler.units definitions
|
||||
graphs grouping kernel namespaces sequences words fry
|
||||
stack-checker.dependencies combinators ;
|
||||
stack-checker.dependencies combinators sets ;
|
||||
IN: compiler.crossref
|
||||
|
||||
SYMBOL: compiled-crossref
|
||||
|
@ -22,24 +22,21 @@ generic-call-site-crossref [ H{ } clone ] initialize
|
|||
: conditional-dependencies-of ( word -- assoc )
|
||||
effect-dependencies-of [ nip conditional-dependency dependency>= ] assoc-filter ;
|
||||
|
||||
: outdated-definition-usages ( assoc -- assocs )
|
||||
[ drop word? ] assoc-filter
|
||||
[ drop definition-dependencies-of ] { } assoc>map ;
|
||||
: outdated-definition-usages ( set -- assocs )
|
||||
members [ word? ] filter [ definition-dependencies-of ] map ;
|
||||
|
||||
: outdated-effect-usages ( assoc -- assocs )
|
||||
[ drop word? ] assoc-filter
|
||||
[ drop effect-dependencies-of ] { } assoc>map ;
|
||||
: outdated-effect-usages ( set -- assocs )
|
||||
members [ word? ] filter [ effect-dependencies-of ] map ;
|
||||
|
||||
: dependencies-satisfied? ( word cache -- ? )
|
||||
[ "dependency-checks" word-prop ] dip
|
||||
'[ _ [ satisfied? ] cache ] all? ;
|
||||
|
||||
: outdated-conditional-usages ( assoc -- assocs )
|
||||
H{ } clone '[
|
||||
drop
|
||||
: outdated-conditional-usages ( set -- assocs )
|
||||
members H{ } clone '[
|
||||
conditional-dependencies-of
|
||||
[ drop _ dependencies-satisfied? not ] assoc-filter
|
||||
] { } assoc>map ;
|
||||
] map ;
|
||||
|
||||
: generic-call-sites-of ( word -- assoc )
|
||||
generic-call-site-crossref get at ;
|
||||
|
|
|
@ -71,7 +71,7 @@ M: f update-call-sites
|
|||
2drop { } ;
|
||||
|
||||
M: f to-recompile
|
||||
changed-definitions get [ drop word? ] assoc-filter keys ;
|
||||
changed-definitions get members [ word? ] filter ;
|
||||
|
||||
M: f recompile
|
||||
[ dup def>> ] { } map>assoc ;
|
||||
|
@ -121,25 +121,24 @@ M: object always-bump-effect-counter? drop f ;
|
|||
|
||||
: updated-definitions ( -- set )
|
||||
HS{ } clone
|
||||
forgotten-definitions get keys over adjoin-all
|
||||
forgotten-definitions get union!
|
||||
new-definitions get first keys over adjoin-all
|
||||
new-definitions get second keys over adjoin-all
|
||||
changed-definitions get keys over adjoin-all
|
||||
maybe-changed get keys over adjoin-all
|
||||
changed-definitions get union!
|
||||
maybe-changed get union!
|
||||
dup changed-vocabs over adjoin-all ;
|
||||
|
||||
: process-forgotten-definitions ( -- )
|
||||
forgotten-definitions get keys
|
||||
forgotten-definitions get members
|
||||
[ [ word? ] filter process-forgotten-words ]
|
||||
[ [ delete-definition-errors ] each ]
|
||||
bi ;
|
||||
|
||||
: bump-effect-counter? ( -- ? )
|
||||
changed-effects get
|
||||
maybe-changed get
|
||||
changed-definitions get [ drop always-bump-effect-counter? ] assoc-filter
|
||||
3array assoc-combine
|
||||
new-words get [ nip key? not ] curry assoc-any? ;
|
||||
changed-effects get members
|
||||
maybe-changed get members
|
||||
changed-definitions get members [ always-bump-effect-counter? ] filter
|
||||
3array combine new-words get [ in? not ] curry any? ;
|
||||
|
||||
: bump-effect-counter ( -- )
|
||||
bump-effect-counter? [
|
||||
|
@ -152,10 +151,10 @@ M: object always-bump-effect-counter? drop f ;
|
|||
[ drop ] [ notify-definition-observers notify-error-observers ] if ;
|
||||
|
||||
: update-existing? ( defs -- ? )
|
||||
new-words get [ key? not ] curry any? ;
|
||||
new-words get [ in? not ] curry any? ;
|
||||
|
||||
: reset-pics? ( -- ? )
|
||||
outdated-generics get assoc-empty? not ;
|
||||
outdated-generics get null? not ;
|
||||
|
||||
: finish-compilation-unit ( -- )
|
||||
[ ] [
|
||||
|
@ -172,7 +171,7 @@ M: object always-bump-effect-counter? drop f ;
|
|||
TUPLE: nesting-observer new-words ;
|
||||
|
||||
M: nesting-observer definitions-changed
|
||||
[ members ] dip new-words>> [ delete-at ] curry each ;
|
||||
[ members ] dip new-words>> [ delete ] curry each ;
|
||||
|
||||
: add-nesting-observer ( -- )
|
||||
new-words get nesting-observer boa
|
||||
|
@ -185,12 +184,12 @@ PRIVATE>
|
|||
|
||||
: with-nested-compilation-unit ( quot -- )
|
||||
[
|
||||
H{ } clone changed-definitions set
|
||||
H{ } clone maybe-changed set
|
||||
H{ } clone changed-effects set
|
||||
H{ } clone outdated-generics set
|
||||
HS{ } clone changed-definitions set
|
||||
HS{ } clone maybe-changed set
|
||||
HS{ } clone changed-effects set
|
||||
HS{ } clone outdated-generics set
|
||||
H{ } clone outdated-tuples set
|
||||
H{ } clone new-words set
|
||||
HS{ } clone new-words set
|
||||
add-nesting-observer
|
||||
[
|
||||
remove-nesting-observer
|
||||
|
@ -202,6 +201,6 @@ PRIVATE>
|
|||
[
|
||||
<definitions> new-definitions set
|
||||
<definitions> old-definitions set
|
||||
H{ } clone forgotten-definitions set
|
||||
HS{ } clone forgotten-definitions set
|
||||
with-nested-compilation-unit
|
||||
] with-scope ; inline
|
||||
|
|
|
@ -1,24 +1,24 @@
|
|||
! Copyright (C) 2006, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs kernel namespaces sequences ;
|
||||
USING: accessors assocs kernel namespaces sequences sets ;
|
||||
IN: definitions
|
||||
|
||||
MIXIN: definition
|
||||
|
||||
ERROR: no-compilation-unit definition ;
|
||||
|
||||
: set-in-unit ( value key assoc -- )
|
||||
[ set-at ] [ no-compilation-unit ] if* ;
|
||||
: add-to-unit ( key set -- )
|
||||
[ adjoin ] [ no-compilation-unit ] if* ;
|
||||
|
||||
SYMBOL: changed-definitions
|
||||
|
||||
: changed-definition ( defspec -- )
|
||||
dup changed-definitions get set-in-unit ;
|
||||
changed-definitions get add-to-unit ;
|
||||
|
||||
SYMBOL: maybe-changed
|
||||
|
||||
: changed-conditionally ( class -- )
|
||||
dup maybe-changed get set-in-unit ;
|
||||
maybe-changed get add-to-unit ;
|
||||
|
||||
SYMBOL: changed-effects
|
||||
|
||||
|
@ -27,10 +27,10 @@ SYMBOL: outdated-generics
|
|||
SYMBOL: new-words
|
||||
|
||||
: new-word ( word -- )
|
||||
dup new-words get set-in-unit ;
|
||||
new-words get add-to-unit ;
|
||||
|
||||
: new-word? ( word -- ? )
|
||||
new-words get key? ;
|
||||
new-words get in? ;
|
||||
|
||||
GENERIC: where ( defspec -- loc )
|
||||
|
||||
|
@ -43,7 +43,7 @@ GENERIC: forget* ( defspec -- )
|
|||
SYMBOL: forgotten-definitions
|
||||
|
||||
: forgotten-definition ( defspec -- )
|
||||
dup forgotten-definitions get set-in-unit ;
|
||||
forgotten-definitions get add-to-unit ;
|
||||
|
||||
: forget ( defspec -- ) [ forgotten-definition ] [ forget* ] bi ;
|
||||
|
||||
|
|
|
@ -4,6 +4,7 @@ USING: accessors arrays assocs classes classes.algebra
|
|||
classes.algebra.private classes.maybe classes.private
|
||||
combinators definitions kernel make namespaces sequences sets
|
||||
words ;
|
||||
FROM: sets => members ;
|
||||
IN: generic
|
||||
|
||||
! Method combination protocol
|
||||
|
@ -96,10 +97,11 @@ ERROR: check-method-error class generic ;
|
|||
] unless ; inline
|
||||
|
||||
: remake-generic ( generic -- )
|
||||
dup outdated-generics get set-in-unit ;
|
||||
outdated-generics get add-to-unit ;
|
||||
|
||||
: remake-generics ( -- )
|
||||
outdated-generics get keys [ generic? ] filter [ make-generic ] each ;
|
||||
outdated-generics get members [ generic? ] filter
|
||||
[ make-generic ] each ;
|
||||
|
||||
GENERIC: update-generic ( class generic -- )
|
||||
|
||||
|
|
|
@ -3,8 +3,8 @@
|
|||
USING: accessors arrays assocs classes combinators
|
||||
compiler.units continuations definitions effects io
|
||||
io.encodings.utf8 io.files kernel lexer math.parser namespaces
|
||||
parser.notes quotations sequences slots source-files vectors
|
||||
vocabs vocabs.parser words words.symbol ;
|
||||
parser.notes quotations sequences sets slots source-files
|
||||
vectors vocabs vocabs.parser words words.symbol ;
|
||||
IN: parser
|
||||
|
||||
: location ( -- loc )
|
||||
|
@ -90,7 +90,7 @@ ERROR: staging-violation word ;
|
|||
pop-parsing-word ; inline
|
||||
|
||||
: execute-parsing ( accum word -- accum )
|
||||
dup changed-definitions get key? [ staging-violation ] when
|
||||
dup changed-definitions get in? [ staging-violation ] when
|
||||
(execute-parsing) ;
|
||||
|
||||
: scan-object ( -- object )
|
||||
|
|
|
@ -93,7 +93,7 @@ M: word parent-word drop f ;
|
|||
over changed-definition [ ] like >>def drop ;
|
||||
|
||||
: changed-effect ( word -- )
|
||||
[ dup changed-effects get set-in-unit ]
|
||||
[ changed-effects get add-to-unit ]
|
||||
[ dup primitive? [ drop ] [ changed-definition ] if ] bi ;
|
||||
|
||||
: set-stack-effect ( effect word -- )
|
||||
|
|
Loading…
Reference in New Issue