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

@ -98,7 +98,7 @@ DEFER: (infer)
[ drop f ] when [ drop f ] when
] catch ; ] catch ;
: infer-branches ( consume instruction brachlist -- ) : infer-branches ( consume instruction branchlist -- )
#! Recursive stack effect inference is done here. If one of #! Recursive stack effect inference is done here. If one of
#! the branches has an undecidable stack effect, we set the #! the branches has an undecidable stack effect, we set the
#! base case to this stack effect and try again. #! base case to this stack effect and try again.

View File

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

View File

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

View File

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