basis/compiler/cfg/dominance/dominance-tests.factor

   1 USING: accessors arrays assocs compiler.cfg.dominance
   2 compiler.cfg.dominance.private compiler.cfg.utilities compiler.test
   3 grouping kernel ranges namespaces sequences sets tools.test ;
   4 IN: compiler.cfg.dominance.tests
   5
   6 : test-dominance ( -- )
   7     0 get block>cfg needs-dominance ;
   8
   9 ! Example with no back edges
  10 V{ } 0 test-bb
  11 V{ } 1 test-bb
  12 V{ } 2 test-bb
  13 V{ } 3 test-bb
  14 V{ } 4 test-bb
  15 V{ } 5 test-bb
  16
  17 0 { 1 2 } edges
  18 1 3 edge
  19 2 4 edge
  20 3 4 edge
  21 4 5 edge
  22
  23 { } [ test-dominance ] unit-test
  24
  25 { t } [ 0 get dom-parent 0 get eq? ] unit-test
  26 { t } [ 1 get dom-parent 0 get eq? ] unit-test
  27 { t } [ 2 get dom-parent 0 get eq? ] unit-test
  28 { t } [ 4 get dom-parent 0 get eq? ] unit-test
  29 { t } [ 3 get dom-parent 1 get eq? ] unit-test
  30 { t } [ 5 get dom-parent 4 get eq? ] unit-test
  31
  32 { t } [ 0 get dom-children 1 get 2 get 4 get 3array set= ] unit-test
  33
  34 { t } [ 0 get 3 get dominates? ] unit-test
  35 { f } [ 3 get 4 get dominates? ] unit-test
  36 { f } [ 1 get 4 get dominates? ] unit-test
  37 { t } [ 4 get 5 get dominates? ] unit-test
  38 { f } [ 1 get 5 get dominates? ] unit-test
  39
  40 ! Example from the paper
  41 V{ } 0 test-bb
  42 V{ } 1 test-bb
  43 V{ } 2 test-bb
  44 V{ } 3 test-bb
  45 V{ } 4 test-bb
  46
  47 0 { 1 2 } edges
  48 1 3 edge
  49 2 4 edge
  50 3 4 edge
  51 4 3 edge
  52
  53 { } [ test-dominance ] unit-test
  54
  55 { t } [ 0 4 [a..b] [ get dom-parent 0 get eq? ] all? ] unit-test
  56
  57 ! The other example from the paper
  58 V{ } 0 test-bb
  59 V{ } 1 test-bb
  60 V{ } 2 test-bb
  61 V{ } 3 test-bb
  62 V{ } 4 test-bb
  63 V{ } 5 test-bb
  64
  65 0 { 1 2 } edges
  66 1 5 edge
  67 2 { 4 3 } edges
  68 5 4 edge
  69 4 { 5 3 } edges
  70 3 4 edge
  71
  72 { } [ test-dominance ] unit-test
  73
  74 { t } [ 0 5 [a..b] [ get dom-parent 0 get eq? ] all? ] unit-test
  75
  76 : non-det-test ( -- cfg )
  77     9 <iota> [ V{ } clone over insns>block ] { } map>assoc dup
  78     {
  79         { 0 1 }
  80         { 1 2 } { 1 7 }
  81         { 2 3 } { 2 5 }
  82         { 3 4 }
  83         { 5 6 }
  84         { 7 8 }
  85     } make-edges 0 of block>cfg ;
  86
  87 : dom-childrens>numbers ( -- assoc )
  88     dom-childrens get
  89     [ [ number>> ] [ [ number>> ] map ] bi* ] assoc-map ;
  90
  91 ! It is essential that the same dominance map is created each time and
  92 ! that it does not differ due to hashing irregularities.
  93 { t } [
  94     20 [
  95         non-det-test needs-dominance dom-childrens>numbers
  96     ] replicate all-equal?
  97 ] unit-test