diff --git a/core/compiler/compiler.factor b/core/compiler/compiler.factor index 784104d57f..8d9f004270 100755 --- a/core/compiler/compiler.factor +++ b/core/compiler/compiler.factor @@ -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 ) [ diff --git a/core/compiler/test/redefine.factor b/core/compiler/test/redefine.factor index 718e98c9c2..266b331ffc 100755 --- a/core/compiler/test/redefine.factor +++ b/core/compiler/test/redefine.factor @@ -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 diff --git a/core/words/words.factor b/core/words/words.factor index 6d8bad4f9e..5dc89212a8 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -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 ;