Add some more compiled-usage tests
parent
3fd5d8c40e
commit
c86e95bc30
|
@ -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 ;
|
||||
|
|
|
@ -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 ) <array> >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
|
||||
|
|
|
@ -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
|
||||
] [
|
||||
|
|
Loading…
Reference in New Issue