1 IN: compiler.tree.normalization.tests
2 USING: compiler.tree.builder compiler.tree.recursive
3 compiler.tree.normalization
4 compiler.tree.normalization.introductions
5 compiler.tree.normalization.renaming
6 compiler.tree compiler.tree.checker
7 sequences accessors tools.test kernel math ;
9 \ count-introductions must-infer
10 \ normalize must-infer
12 [ 3 ] [ [ 3drop 1 2 3 ] build-tree count-introductions ] unit-test
14 [ 4 ] [ [ 3drop 1 2 3 3drop drop ] build-tree count-introductions ] unit-test
16 [ 3 ] [ [ [ drop ] [ 2drop 3 ] if ] build-tree count-introductions ] unit-test
18 [ 2 ] [ [ 3 [ drop ] [ 2drop 3 ] if ] build-tree count-introductions ] unit-test
20 : foo ( a b -- b a ) swap ; inline recursive
22 : recursive-inputs ( nodes -- n )
23 [ #recursive? ] find nip child>> first in-d>> length ;
28 [ analyze-recursive normalize recursive-inputs ] bi
31 : test-normalization ( quot -- )
32 build-tree analyze-recursive normalize check-nodes ;
34 [ ] [ [ [ 1 ] [ 2 ] if + * ] test-normalization ] unit-test
37 : aaa ( obj x -- obj ) dup [ dup [ bbb ] dip aaa ] [ drop ] if ; inline recursive
38 : bbb ( obj x -- obj ) [ drop 0 ] dip aaa ; inline recursive
40 [ ] [ [ bbb ] test-normalization ] unit-test
42 : ccc ( obj -- 1 ) ccc drop 1 ; inline recursive
44 [ ] [ [ ccc ] test-normalization ] unit-test
47 : ddd ( a b -- a b ) eee ; inline recursive
48 : eee ( a b -- a b ) swap ddd ; inline recursive
50 [ ] [ [ eee ] test-normalization ] unit-test
52 : call-recursive-5 ( -- ) call-recursive-5 ; inline recursive
54 [ ] [ [ call-recursive-5 swap ] test-normalization ] unit-test