Fix another problem with call( inline caching
parent
7377c96a21
commit
5470330c45
|
@ -127,8 +127,8 @@ M: object bump-effect-counter* drop f ;
|
||||||
bi ;
|
bi ;
|
||||||
|
|
||||||
: bump-effect-counter? ( -- ? )
|
: bump-effect-counter? ( -- ? )
|
||||||
changed-effects get old-definitions get first assoc-intersect assoc-empty? not
|
changed-effects get new-words get assoc-diff assoc-empty? not
|
||||||
new-definitions get first [ drop bump-effect-counter* ] assoc-any?
|
changed-definitions get [ drop bump-effect-counter* ] assoc-any?
|
||||||
or ;
|
or ;
|
||||||
|
|
||||||
: bump-effect-counter ( -- )
|
: bump-effect-counter ( -- )
|
||||||
|
@ -156,6 +156,7 @@ PRIVATE>
|
||||||
H{ } clone changed-effects set
|
H{ } clone changed-effects set
|
||||||
H{ } clone outdated-generics set
|
H{ } clone outdated-generics set
|
||||||
H{ } clone outdated-tuples set
|
H{ } clone outdated-tuples set
|
||||||
|
H{ } clone new-words set
|
||||||
H{ } clone new-classes set
|
H{ } clone new-classes set
|
||||||
[ finish-compilation-unit ] [ ] cleanup
|
[ finish-compilation-unit ] [ ] cleanup
|
||||||
] with-scope ; inline
|
] with-scope ; inline
|
||||||
|
@ -168,6 +169,7 @@ PRIVATE>
|
||||||
H{ } clone outdated-generics set
|
H{ } clone outdated-generics set
|
||||||
H{ } clone forgotten-definitions set
|
H{ } clone forgotten-definitions set
|
||||||
H{ } clone outdated-tuples set
|
H{ } clone outdated-tuples set
|
||||||
|
H{ } clone new-words set
|
||||||
H{ } clone new-classes set
|
H{ } clone new-classes set
|
||||||
<definitions> new-definitions set
|
<definitions> new-definitions set
|
||||||
<definitions> old-definitions set
|
<definitions> old-definitions set
|
||||||
|
|
|
@ -21,8 +21,16 @@ SYMBOL: changed-generics
|
||||||
|
|
||||||
SYMBOL: outdated-generics
|
SYMBOL: outdated-generics
|
||||||
|
|
||||||
|
SYMBOL: new-words
|
||||||
|
|
||||||
SYMBOL: new-classes
|
SYMBOL: new-classes
|
||||||
|
|
||||||
|
: new-word ( word -- )
|
||||||
|
dup new-words get set-in-unit ;
|
||||||
|
|
||||||
|
: new-word? ( word -- ? )
|
||||||
|
new-words get key? ;
|
||||||
|
|
||||||
: new-class ( word -- )
|
: new-class ( word -- )
|
||||||
dup new-classes get set-in-unit ;
|
dup new-classes get set-in-unit ;
|
||||||
|
|
||||||
|
|
|
@ -135,7 +135,7 @@ M: word reset-word
|
||||||
] tri ;
|
] tri ;
|
||||||
|
|
||||||
: <word> ( name vocab -- word )
|
: <word> ( name vocab -- word )
|
||||||
2dup [ hashcode ] bi@ bitxor >fixnum (word) ;
|
2dup [ hashcode ] bi@ bitxor >fixnum (word) dup new-word ;
|
||||||
|
|
||||||
: gensym ( -- word )
|
: gensym ( -- word )
|
||||||
"( gensym )" f \ gensym counter >fixnum (word) ;
|
"( gensym )" f \ gensym counter >fixnum (word) ;
|
||||||
|
|
Loading…
Reference in New Issue