-IN: compiler.tree.recursive.tests
-USING: compiler.tree.recursive tools.test
-kernel combinators.short-circuit math sequences accessors
+USING: tools.test kernel combinators.short-circuit math sequences accessors
compiler.tree
compiler.tree.builder
-compiler.tree.combinators ;
+compiler.tree.combinators
+compiler.tree.recursive
+compiler.tree.recursive.private ;
+IN: compiler.tree.recursive.tests
[ { f f f f } ] [ f { f t f f } (tail-calls) ] unit-test
[ { f f f t } ] [ t { f t f f } (tail-calls) ] unit-test
] curry contains-node? ;
: loop-test-1 ( a -- )
- dup [ 1+ loop-test-1 ] [ drop ] if ; inline recursive
+ dup [ 1 + loop-test-1 ] [ drop ] if ; inline recursive
[ t ] [
[ loop-test-1 ] build-tree analyze-recursive
] unit-test
: loop-test-2 ( a b -- a' )
- dup [ 1+ loop-test-2 1- ] [ drop ] if ; inline recursive
+ dup [ 1+ loop-test-2 1 - ] [ drop ] if ; inline recursive
[ t ] [
[ loop-test-2 ] build-tree analyze-recursive
\ loop-test-3 label-is-not-loop?
] unit-test
-: loop-test-4 ( a -- )
- dup [
- loop-test-4
- ] [
- drop
- ] if ; inline recursive
-
[ f ] [
[ [ [ ] map ] map ] build-tree analyze-recursive
[
DEFER: a''
-: b'' ( -- )
+: b'' ( a -- b )
a'' ; inline recursive
-: a'' ( -- )
- b'' a'' ; inline recursive
+: a'' ( a -- b )
+ dup [ b'' a'' ] when ; inline recursive
[ t ] [
[ a'' ] build-tree analyze-recursive
\ a'' label-is-not-loop?
] unit-test
+[ t ] [
+ [ a'' ] build-tree analyze-recursive
+ \ b'' label-is-loop?
+] unit-test
+
+[ t ] [
+ [ b'' ] build-tree analyze-recursive
+ \ a'' label-is-loop?
+] unit-test
+
+[ t ] [
+ [ b'' ] build-tree analyze-recursive
+ \ b'' label-is-not-loop?
+] unit-test
+
: loop-in-non-loop ( x quot: ( i -- ) -- )
over 0 > [
[ [ 1 - ] dip loop-in-non-loop ] [ call ] 2bi
build-tree analyze-recursive
\ (each-integer) label-is-loop?
] 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
+
+DEFER: b4
+
+: a4 ( a -- b ) dup [ b4 ] when ; inline recursive
+
+: b4 ( a -- b ) dup [ a4 reverse ] when ; inline recursive
+
+[ t ] [ [ b4 ] build-tree analyze-recursive \ a4 label-is-loop? ] unit-test
+[ t ] [ [ b4 ] build-tree analyze-recursive \ b4 label-is-not-loop? ] unit-test
+[ t ] [ [ a4 ] build-tree analyze-recursive \ a4 label-is-not-loop? ] unit-test
+[ t ] [ [ a4 ] build-tree analyze-recursive \ b4 label-is-loop? ] unit-test