Forgetting a word clears compiled usage

db4
Slava Pestov 2008-01-24 03:20:05 -04:00
parent 83d6e10ac0
commit ecc0170afa
3 changed files with 31 additions and 17 deletions

View File

@ -7,21 +7,6 @@ optimizer definitions math compiler.errors threads graphs
generic ;
IN: compiler
SYMBOL: compiled-crossref
compiled-crossref global [ H{ } assoc-like ] change-at
: compiled-xref ( word dependencies -- )
2dup "compiled-uses" set-word-prop
compiled-crossref get add-vertex* ;
: compiled-unxref ( word -- )
dup "compiled-uses" word-prop
compiled-crossref get remove-vertex* ;
: compiled-usage ( word -- assoc )
compiled-crossref get at ;
: compiled-usages ( words -- seq )
[ [ dup ] H{ } map>assoc dup ] keep [
compiled-usage [ nip +inlined+ eq? ] assoc-subset update
@ -41,7 +26,7 @@ compiled-crossref global [ H{ } assoc-like ] change-at
>r dupd save-effect r>
f pick compiler-error
over compiled-unxref
compiled-xref ;
over word-vocabulary [ compiled-xref ] [ 2drop ] if ;
: compile-succeeded ( word -- effect dependencies )
[

View File

@ -1,6 +1,6 @@
USING: compiler definitions generic assocs inference math
namespaces parser tools.test words kernel sequences arrays io
effects tools.test.inference compiler.units ;
effects tools.test.inference compiler.units inference.state ;
IN: temporary
DEFER: x-1
@ -206,12 +206,15 @@ DEFER: generic-then-not-generic-test-2
[ 4 ] [ generic-then-not-generic-test-2 ] unit-test
DEFER: foldable-test-1
DEFER: foldable-test-2
[ ] [ "IN: temporary : foldable-test-1 3 ; foldable" eval ] unit-test
[ ] [ "IN: temporary : foldable-test-2 foldable-test-1 ;" eval ] unit-test
[ +inlined+ ] [ \ foldable-test-2 \ foldable-test-1 compiled-usage at ] unit-test
[ 3 ] [ foldable-test-2 ] unit-test
[ ] [ "IN: temporary : foldable-test-1 4 ; foldable" eval ] unit-test
@ -229,3 +232,9 @@ DEFER: flushable-test-2
[ ] [ "IN: temporary USING: kernel sequences ; : flushable-test-1 3 over push ;" eval ] unit-test
[ V{ 3 } ] [ flushable-test-2 ] unit-test
: ax ;
: bx ax ;
[ \ bx forget ] with-compilation-unit
[ t ] [ \ ax compiled-usage [ drop interned? ] assoc-all? ] unit-test

View File

@ -87,6 +87,25 @@ M: wrapper (quot-uses) >r wrapped r> (quot-uses) ;
M: word uses ( word -- seq )
word-def quot-uses keys ;
SYMBOL: compiled-crossref
compiled-crossref global [ H{ } assoc-like ] change-at
: compiled-xref ( word dependencies -- )
2dup "compiled-uses" set-word-prop
compiled-crossref get add-vertex* ;
: compiled-unxref ( word -- )
dup "compiled-uses" word-prop
compiled-crossref get remove-vertex* ;
: delete-compiled-xref ( word -- )
dup compiled-unxref
compiled-crossref get delete-at ;
: compiled-usage ( word -- assoc )
compiled-crossref get at ;
M: word redefined* ( word -- )
{ "inferred-effect" "base-case" "no-effect" } reset-props ;
@ -187,6 +206,7 @@ M: word (forget-word)
: forget-word ( word -- )
dup delete-xref
dup delete-compiled-xref
(forget-word) ;
M: word forget* forget-word ;