Inference bug fix

slava 2006-05-23 01:55:46 +00:00
parent c3677c7147
commit 716d9be374
2 changed files with 9 additions and 12 deletions

View File

@ -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 ( -- )

View File

@ -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 ;