inferencer fixes

cvs
Slava Pestov 2004-11-27 05:51:28 +00:00
parent 15a07f6f40
commit 8c23dbb554
4 changed files with 12 additions and 6 deletions

View File

@ -93,12 +93,12 @@ DEFER: (infer)
: recursive-branch ( quot -- ? )
#! Set base case if inference didn't fail.
[
car infer-branch drop recursive-state get set-base t
car infer-branch drop recursive-state get set-base t
] [
[ drop f ] when
] catch ;
: infer-branches ( consume instruction brachlist -- )
: infer-branches ( consume instruction branchlist -- )
#! Recursive stack effect inference is done here. If one of
#! the branches has an undecidable stack effect, we set the
#! base case to this stack effect and try again.

View File

@ -53,7 +53,7 @@ SYMBOL: 2GENERIC
unit cons cons dataflow-graph cons@ ;
: dataflow-literal, ( lit -- )
>r 0 PUSH r> dataflow, ;
>r f PUSH r> dataflow, ;
: dataflow-word, ( in word -- )
>r count CALL r> dataflow, ;

View File

@ -138,9 +138,13 @@ DEFER: apply-word
: set-base ( [ in | stack ] rstate -- )
#! Set the base case of the current word.
>r uncons vector-length cons r> car cdr [
entry-effect get swap decompose base-case set
] bind ;
dup [
>r uncons vector-length cons r> car cdr [
entry-effect get swap decompose base-case set
] bind
] [
2drop
] ifte ;
: infer ( quot -- [ in | out ] )
#! Stack effect of a quotation.

View File

@ -193,3 +193,5 @@ SYMBOL: sym-test
[ [ 1 | 0 ] ] [ [ >n ] infer ] unit-test
[ [ 0 | 1 ] ] [ [ n> ] infer ] unit-test
[ [ 1 | 1 ] ] [ [ get ] infer ] unit-test