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

compiler.tree.recursive: add some more more loop detection tests

db4
Slava Pestov 2009-08-04 16:23:14 -05:00
parent 9aba341bdb
commit eed4f4dcfc
1 changed files with 31 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
basis/compiler/tree/recursive/recursive-tests.factor
View File

@ -67,13 +67,6 @@ compiler.tree.combinators ;
\ loop-test-3 label-is-not-loop? \ loop-test-3 label-is-not-loop?
] unit-test ] unit-test
: loop-test-4 ( a -- )
dup [
loop-test-4
] [
drop
] if ; inline recursive
[ f ] [ [ f ] [
[ [ [ ] map ] map ] build-tree analyze-recursive [ [ [ ] map ] map ] build-tree analyze-recursive
[ [
@ -145,17 +138,32 @@ DEFER: a'
DEFER: a'' DEFER: a''
: b'' ( -- ) : b'' ( a -- b )
a'' ; inline recursive a'' ; inline recursive
: a'' ( -- ) : a'' ( a -- b )
b'' a'' ; inline recursive dup [ b'' a'' ] when ; inline recursive
[ t ] [ [ t ] [
[ a'' ] build-tree analyze-recursive [ a'' ] build-tree analyze-recursive
\ a'' label-is-not-loop? \ a'' label-is-not-loop?
] unit-test ] unit-test
[ t ] [
[ a'' ] build-tree analyze-recursive
\ b'' label-is-loop?
] unit-test
[ t ] [
[ b'' ] build-tree analyze-recursive
\ a'' label-is-not-loop?
] unit-test
[ f ] [
[ b'' ] build-tree analyze-recursive
\ b'' label-is-not-loop?
] unit-test
: loop-in-non-loop ( x quot: ( i -- ) -- ) : loop-in-non-loop ( x quot: ( i -- ) -- )
over 0 > [ over 0 > [
[ [ 1 - ] dip loop-in-non-loop ] [ call ] 2bi [ [ 1 - ] dip loop-in-non-loop ] [ call ] 2bi
@ -166,3 +174,16 @@ DEFER: a''
build-tree analyze-recursive build-tree analyze-recursive
\ (each-integer) label-is-loop? \ (each-integer) label-is-loop?
] unit-test ] unit-test
DEFER: a'''
: b''' ( -- )
blah [ b''' ] [ a''' b''' ] if ; inline recursive
: a''' ( -- )
blah [ b''' ] [ a''' ] if ; inline recursive
[ t ] [
[ b''' ] build-tree analyze-recursive
\ a''' label-is-loop?
] unit-test