basis/compiler/tree/def-use/def-use-tests.factor

   1 USING: accessors namespaces assocs kernel sequences math
   2 tools.test words sets combinators.short-circuit
   3 stack-checker.state compiler.tree compiler.tree.builder
   4 compiler.tree.recursive compiler.tree.normalization
   5 compiler.tree.propagation compiler.tree.cleanup
   6 compiler.tree.def-use arrays kernel.private sorting math.order
   7 binary-search compiler.tree.checker ;
   8 IN: compiler.tree.def-use.tests
   9
  10 \ compute-def-use must-infer
  11
  12 [ t ] [
  13     [ 1 2 3 ] build-tree compute-def-use drop
  14     def-use get {
  15         [ assoc-size 3 = ]
  16         [ values [ uses>> [ #return? ] all? ] all? ]
  17     } 1&&
  18 ] unit-test
  19
  20 : test-def-use ( quot -- )
  21     build-tree
  22     analyze-recursive
  23     normalize
  24     propagate
  25     cleanup
  26     compute-def-use
  27     check-nodes ;
  28
  29 : too-deep ( a b -- c )
  30     dup [ drop ] [ 2dup too-deep too-deep drop ] if ; inline recursive
  31
  32 [ ] [
  33     [ too-deep ]
  34     build-tree
  35     analyze-recursive
  36     normalize
  37     compute-def-use
  38     check-nodes
  39 ] unit-test
  40
  41 ! compute-def-use checks for SSA violations, so we use that to
  42 ! ensure we generate some common patterns correctly.
  43 {
  44     [ [ drop ] each-integer ]
  45     [ [ 2drop ] curry each-integer ]
  46     [ [ 1 ] [ 2 ] if drop ]
  47     [ [ 1 ] [ dup ] if ]
  48     [ [ 1 ] [ dup ] if drop ]
  49     [ { array } declare swap ]
  50     [ [ ] curry call ]
  51     [ [ 1 ] [ 2 ] compose call + ]
  52     [ [ 1 ] 2 [ + ] curry compose call + ]
  53     [ [ 1 ] [ call 2 ] curry call + ]
  54     [ [ 1 ] [ 2 ] compose swap [ 1 ] [ 2 ] if + * ]
  55     [ dup slice? [ dup array? [ ] [ ] if ] [ ] if ]
  56     [ dup [ drop f ] [ "A" throw ] if ]
  57     [ [ <=> ] sort ]
  58     [ [ <=> ] with search ]
  59 } [
  60     [ ] swap [ test-def-use ] curry unit-test
  61 ] each