diff --git a/core/compiler/compiler.factor b/core/compiler/compiler.factor index 5c5c4cf286..0be3aa5362 100755 --- a/core/compiler/compiler.factor +++ b/core/compiler/compiler.factor @@ -22,11 +22,18 @@ compiled-crossref global [ H{ } assoc-like ] change-at : compiled-usage ( word -- seq ) compiled-crossref get at keys ; +: sensitive? ( word -- ? ) + dup "inline" word-prop + over "infer" word-prop + pick "specializer" word-prop + roll generic? + or or or ; + : compiled-usages ( words -- seq ) compiled-crossref get [ [ over dup set - over "inline" word-prop pick generic? or + over sensitive? [ at namespace swap update ] [ 2drop ] if ] curry each ] H{ } make-assoc keys ; diff --git a/core/compiler/test/redefine.factor b/core/compiler/test/redefine.factor index 48504a5bac..f059f9ec81 100755 --- a/core/compiler/test/redefine.factor +++ b/core/compiler/test/redefine.factor @@ -143,3 +143,33 @@ DEFER: g-test-7 [ ] [ "IN: temporary USE: math GENERIC: g-test-1 ( x -- y ) M: integer g-test-1 15 + ;" eval ] unit-test [ 138 ] [ g-test-7 ] unit-test + +USE: macros + +DEFER: macro-test-3 + +[ ] [ "IN: temporary USING: macros math ; : macro-test-1 sq ;" eval ] unit-test + +[ ] [ "IN: temporary USING: macros arrays quotations ; MACRO: macro-test-2 ( n word -- quot ) >quotation ;" eval ] unit-test + +[ ] [ "IN: temporary : macro-test-3 2 \\ macro-test-1 macro-test-2 ;" eval ] unit-test + +[ 625 ] [ 5 macro-test-3 ] unit-test + +[ ] [ "IN: temporary USING: macros arrays quotations kernel math ; MACRO: macro-test-2 ( n word -- quot ) 2drop [ 3 + ] ;" eval ] unit-test + +[ 8 ] [ 5 macro-test-3 ] unit-test + +USE: hints + +DEFER: hints-test-2 + +[ ] [ "IN: temporary USING: math hints ; : hints-test-1 3 + ; HINTS: hints-test-1 fixnum ;" eval ] unit-test + +[ ] [ "IN: temporary : hints-test-2 5 hints-test-1 ;" eval ] unit-test + +[ 8 ] [ hints-test-2 ] unit-test + +[ ] [ "IN: temporary USE: math : hints-test-1 5 + ;" eval ] unit-test + +[ 10 ] [ hints-test-2 ] unit-test diff --git a/core/inference/backend/backend.factor b/core/inference/backend/backend.factor index 5003336164..e8138577f5 100755 --- a/core/inference/backend/backend.factor +++ b/core/inference/backend/backend.factor @@ -76,7 +76,7 @@ GENERIC: apply-object ( obj -- ) M: object apply-object apply-literal ; -M: wrapper apply-object wrapped apply-literal ; +M: wrapper apply-object wrapped dup depends-on apply-literal ; : terminate ( -- ) terminated? on #terminate node, ; @@ -336,7 +336,6 @@ TUPLE: unbalanced-branches-error quots in out ; recursive-label #call-label [ consume/produce ] keep set-node-in-d ] [ - dup depends-on over effect-in length reify-curries #call consume/produce ] if ; @@ -437,7 +436,6 @@ M: #call-label collect-recursion* [ set ] 2each ; : inline-word ( word -- ) - dup depends-on dup inline-block over recursive-label? [ flatten-meta-d >r drop join-values inline-block apply-infer @@ -451,7 +449,7 @@ M: #call-label collect-recursion* ] if ; M: word apply-object - [ + dup depends-on [ dup inline-recursive-label [ declared-infer ] [ inline-word ] if ] [