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

   1 USING: accessors assocs compiler.cfg.linearization
   2 compiler.cfg.linearization.private compiler.cfg.utilities
   3 compiler.test kernel make namespaces sequences tools.test ;
   4 IN: compiler.cfg.linearization.tests
   5
   6 ! linearization-order
   7 V{ } 0 test-bb
   8
   9 V{ } 1 test-bb
  10
  11 V{ } 2 test-bb
  12
  13 0 { 1 1 } edges
  14 1 2 edge
  15
  16 { { 0 1 2 } } [
  17     0 get block>cfg linearization-order [ number>> ] map
  18 ] unit-test
  19
  20 : two-successors-cfg ( -- cfg )
  21     V{ } 10 insns>block
  22     [ V{ } 20 insns>block connect-bbs ] keep
  23     [ V{ } 30 insns>block connect-bbs ] keep
  24     block>cfg ;
  25
  26 ! (linearization-order)
  27 { { 10 20 30 } } [
  28     two-successors-cfg (linearization-order) [ number>> ] map
  29 ] unit-test
  30
  31 { { 0 1 2 3 4 5 } } [
  32     6 <iota> [ V{ } clone over insns>block ] { } map>assoc dup
  33     {
  34         { 0 1 } { 0 2 } { 0 5 }
  35         { 2 3 }
  36         { 3 4 }
  37         { 4 2 }
  38     } make-edges
  39     0 of block>cfg (linearization-order)
  40     [ number>> ] map
  41 ] unit-test
  42
  43 ! process-block
  44 { { } V{ 10 } } [
  45     HS{ } clone visited set
  46     V{ } 10 insns>block [ process-block ] V{ } make
  47     [ number>> ] map
  48 ] unit-test
  49
  50 ! number-blocks
  51 { { 0 1 2 } } [
  52     two-successors-cfg linearization-order dup number-blocks [ number>> ] map
  53 ] unit-test