steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix stack effects in compiler tests

db4
Joe Groff 2010-03-08 23:46:20 -08:00
parent 191ac353fd
commit bcbc7632c6
5 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/compiler/tests/curry.factor
View File

@ -32,7 +32,7 @@ IN: compiler.tests.curry
compile-call
] unit-test
: foobar ( quot: ( -- ) -- )
: foobar ( quot: ( ..a -- ..b ) -- )
[ call ] keep swap [ foobar ] [ drop ] if ; inline recursive
[ ] [ [ [ f ] foobar ] compile-call ] unit-test

2
basis/compiler/tests/optimizer.factor
View File

@ -198,7 +198,7 @@ USE: sorting
USE: binary-search
USE: binary-search.private
: old-binsearch ( elt quot: ( -- ) seq -- elt quot i )
: old-binsearch ( elt quot: ( ..a -- ..b ) seq -- elt quot i )
dup length 1 <= [
from>>
] [

2
basis/compiler/tree/dead-code/dead-code-tests.factor
View File

@ -168,7 +168,7 @@ IN: compiler.tree.dead-code.tests
[ ] [ [ [ 0 -rot set-nth-unsafe ] curry (each-integer) ] optimize-quot drop ] unit-test
: call-recursive-dce-6 ( i quot: ( i -- ? ) -- i )
: call-recursive-dce-6 ( i quot: ( ..a -- ..b ) -- i )
dup call [ drop ] [ call-recursive-dce-6 ] if ; inline recursive
[ ] [ [ [ ] curry [ ] swap compose call-recursive-dce-6 ] optimize-quot drop ] unit-test

2
basis/compiler/tree/normalization/normalization-tests.factor
View File

@ -14,7 +14,7 @@ IN: compiler.tree.normalization.tests
[ 2 ] [ [ 3 [ drop ] [ 2drop 3 ] if ] build-tree count-introductions ] unit-test
: foo ( quot: ( -- ) -- ) call ; inline recursive
: foo ( ..a quot: ( ..a -- ..b ) -- ..b ) call ; inline recursive
: recursive-inputs ( nodes -- n )
[ #recursive? ] find nip child>> first in-d>> length ;

4
basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor
View File

@ -38,10 +38,10 @@ TUPLE: empty-tuple ;
} [ [ ] swap [ test-unboxing ] curry unit-test ] each
! A more complicated example
: impeach-node ( quot: ( node -- ) -- )
: impeach-node ( quot: ( ..a -- ..b ) -- )
[ call ] keep impeach-node ; inline recursive
: bleach-node ( quot: ( node -- ) -- )
: bleach-node ( quot: ( ..a -- ..b ) -- )
[ bleach-node ] curry [ ] compose impeach-node ; inline recursive
[ ] [ [ [ ] bleach-node ] test-unboxing ] unit-test