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

   1 IN: compiler.tree.normalization.tests
   2 USING: compiler.tree.builder compiler.tree.normalization
   3 compiler.tree compiler.tree.checker
   4 sequences accessors tools.test kernel math ;
   5
   6 \ count-introductions must-infer
   7 \ normalize must-infer
   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 ( -- ) swap ; inline recursive
  18
  19 : recursive-inputs ( nodes -- n )
  20     [ #recursive? ] find nip child>> first in-d>> length ;
  21
  22 [ 0 2 ] [
  23     [ foo ] build-tree
  24     [ recursive-inputs ]
  25     [ normalize recursive-inputs ] bi
  26 ] unit-test
  27
  28 [ ] [ [ [ 1 ] [ 2 ] if + * ] build-tree normalize check-nodes ] unit-test
  29
  30 DEFER: bbb
  31 : aaa ( x -- ) dup [ dup >r bbb r> aaa ] [ drop ] if ; inline recursive
  32 : bbb ( x -- ) >r drop 0 r> aaa ; inline recursive
  33
  34 [ ] [ [ bbb ] build-tree normalize check-nodes ] unit-test
  35
  36 : ccc ( -- ) ccc drop 1 ; inline recursive
  37
  38 [ ] [ [ ccc ] build-tree normalize check-nodes ] unit-test
  39
  40 DEFER: eee
  41 : ddd ( -- ) eee ; inline recursive
  42 : eee ( -- ) swap ddd ; inline recursive
  43
  44 [ ] [ [ eee ] build-tree normalize check-nodes ] unit-test
  45
  46 : call-recursive-5 ( -- ) call-recursive-5 ; inline recursive
  47
  48 [ ] [ [ call-recursive-5 swap ] build-tree normalize check-nodes ] unit-test