basis/compiler/tree/normalization/normalization-tests.factor

   1 USING: compiler.tree.builder compiler.tree.recursive
   2 compiler.tree.normalization
   3 compiler.tree.normalization.introductions
   4 compiler.tree.normalization.renaming
   5 compiler.tree compiler.tree.checker
   6 sequences accessors tools.test kernel math ;
   7 IN: compiler.tree.normalization.tests
   8
   9 [ 3 ] [ [ 3drop 1 2 3 ] build-tree count-introductions ] unit-test
  10
  11 [ 4 ] [ [ 3drop 1 2 3 3drop drop ] build-tree count-introductions ] unit-test
  12
  13 [ 3 ] [ [ [ drop ] [ 2drop 3 ] if ] build-tree count-introductions ] unit-test
  14
  15 [ 2 ] [ [ 3 [ drop ] [ 2drop 3 ] if ] build-tree count-introductions ] unit-test
  16
  17 : foo ( quot: ( -- ) -- ) call ; inline recursive
  18
  19 : recursive-inputs ( nodes -- n )
  20     [ #recursive? ] find nip child>> first in-d>> length ;
  21
  22 [ 1 3 ] [
  23     [ [ swap ] foo ] build-tree
  24     [ recursive-inputs ]
  25     [ analyze-recursive normalize recursive-inputs ] bi
  26 ] unit-test
  27
  28 : test-normalization ( quot -- )
  29     build-tree analyze-recursive normalize check-nodes ;
  30
  31 [ ] [ [ [ 1 ] [ 2 ] if + * ] test-normalization ] unit-test
  32
  33 DEFER: bbb
  34 : aaa ( obj x -- obj ) dup [ dup [ bbb ] dip aaa ] [ drop ] if ; inline recursive
  35 : bbb ( obj x -- obj ) [ drop 0 ] dip aaa ; inline recursive
  36
  37 [ ] [ [ bbb ] test-normalization ] unit-test
  38
  39 : ccc ( obj -- 1 ) ccc drop 1 ; inline recursive
  40
  41 [ ] [ [ ccc ] test-normalization ] unit-test
  42
  43 DEFER: eee
  44 : ddd ( a b -- a b ) eee ; inline recursive
  45 : eee ( a b -- a b ) swap ddd ; inline recursive
  46
  47 [ ] [ [ eee ] test-normalization ] unit-test
  48
  49 : call-recursive-5 ( -- ) call-recursive-5 ; inline recursive
  50
  51 [ ] [ [ call-recursive-5 swap ] test-normalization ] unit-test