Inference bug fix
parent
c3677c7147
commit
716d9be374
|
@ -68,18 +68,13 @@ M: #call-label collect-recursion* ( label node -- )
|
||||||
dup node-param swap
|
dup node-param swap
|
||||||
[ [ collect-recursion* ] each-node-with ] { } make ;
|
[ [ collect-recursion* ] each-node-with ] { } make ;
|
||||||
|
|
||||||
: amend-d-in ( new old -- )
|
|
||||||
[ length ] 2apply - d-in [ + ] change ;
|
|
||||||
|
|
||||||
: join-values ( node -- )
|
: join-values ( node -- )
|
||||||
#! We have to infer recursive labels twice to determine
|
#! We have to infer recursive labels twice to determine
|
||||||
#! which literals survive the recursion (eg, quotations)
|
#! which literals survive the recursion (eg, quotations)
|
||||||
#! and which don't (loop indices, etc). The latter cannot
|
#! and which don't (loop indices, etc). The latter cannot
|
||||||
#! be folded.
|
#! be folded.
|
||||||
meta-d get [
|
collect-recursion meta-d get add unify-stacks
|
||||||
>r collect-recursion r> add unify-lengths
|
meta-d [ length swap tail* ] change ;
|
||||||
flip [ unify-values ] map dup meta-d set
|
|
||||||
] keep amend-d-in ;
|
|
||||||
|
|
||||||
: splice-node ( node -- )
|
: splice-node ( node -- )
|
||||||
#! Labels which do not call themselves are just spliced into
|
#! Labels which do not call themselves are just spliced into
|
||||||
|
@ -174,7 +169,7 @@ M: symbol apply-object ( word -- )
|
||||||
{
|
{
|
||||||
"The base case of a recursive word could not be inferred.\n"
|
"The base case of a recursive word could not be inferred.\n"
|
||||||
"This means the word calls itself in every control flow path.\n"
|
"This means the word calls itself in every control flow path.\n"
|
||||||
"See the handbook for details."
|
"See the documentation for details."
|
||||||
} concat inference-error ;
|
} concat inference-error ;
|
||||||
|
|
||||||
: notify-base-case ( -- )
|
: notify-base-case ( -- )
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
IN: temporary
|
IN: temporary
|
||||||
USING: arrays errors generic inference kernel math
|
USING: arrays errors generic inference kernel kernel-internals
|
||||||
math-internals namespaces parser sequences test vectors ;
|
math math-internals namespaces parser sequences test vectors ;
|
||||||
|
|
||||||
[ f ] [ f [ [ ] map-nodes ] with-node-iterator ] unit-test
|
[ f ] [ f [ [ ] map-nodes ] with-node-iterator ] unit-test
|
||||||
|
|
||||||
|
@ -74,8 +74,6 @@ math-internals namespaces parser sequences test vectors ;
|
||||||
|
|
||||||
[ [ bad-recursion-2 ] infer ] unit-test-fails
|
[ [ bad-recursion-2 ] infer ] unit-test-fails
|
||||||
|
|
||||||
! Not sure how to fix this one
|
|
||||||
|
|
||||||
: funny-recursion
|
: funny-recursion
|
||||||
dup [ funny-recursion 1 ] [ 2 ] if drop ;
|
dup [ funny-recursion 1 ] [ 2 ] if drop ;
|
||||||
|
|
||||||
|
@ -209,6 +207,10 @@ DEFER: do-crap
|
||||||
: do-crap dup [ do-crap ] [ more-crap ] if ;
|
: do-crap dup [ do-crap ] [ more-crap ] if ;
|
||||||
[ [ do-crap ] infer ] unit-test-fails
|
[ [ do-crap ] infer ] unit-test-fails
|
||||||
|
|
||||||
|
! Regression
|
||||||
|
: too-deep dup [ drop ] [ 2dup too-deep too-deep * ] if ; inline
|
||||||
|
[ { 2 1 } ] [ [ too-deep ] infer ] unit-test
|
||||||
|
|
||||||
! Error reporting is wrong
|
! Error reporting is wrong
|
||||||
G: xyz math-combination ;
|
G: xyz math-combination ;
|
||||||
M: fixnum xyz 2array ;
|
M: fixnum xyz 2array ;
|
||||||
|
|
Loading…
Reference in New Issue