extra/compiler/cfg/gvn/testing/testing.factor

   1 ! Copyright (C) 2011 Alex Vondrak.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs compiler.cfg compiler.cfg.graphviz
   4 compiler.cfg.gvn compiler.cfg.gvn.expressions compiler.cfg.gvn.graph
   5 compiler.cfg.optimizer compiler.cfg.utilities compiler.test
   6 continuations formatting graphviz.notation graphviz.render
   7 io.directories kernel math.parser namespaces prettyprint sequences
   8 sorting splitting tools.annotations ;
   9 IN: compiler.cfg.gvn.testing
  10
  11 GENERIC: expr>str ( expr -- str )
  12
  13 M: integer-expr expr>str value>> number>string ;
  14
  15 M: reference-expr expr>str value>> unparse ;
  16
  17 M: sequence expr>str [ unparse ] map " " join ;
  18
  19 M: object expr>str unparse ;
  20
  21 : value-mapping ( from to -- str )
  22     over exprs>vns get value-at* [
  23         expr>str "%d -> <%d> (%s)\\l" sprintf
  24     ] [
  25         drop "%d -> <%d>\\l" sprintf
  26     ] if ;
  27
  28 : gvns ( -- str )
  29     vregs>vns get >alist natural-sort [
  30         first2 value-mapping
  31     ] map "" concat-as ;
  32
  33 : invert-assoc ( assoc -- inverted )
  34     V{ } clone [
  35         [ push-at ] curry assoc-each
  36     ] keep ;
  37
  38 : congruence-classes ( -- str )
  39     vregs>vns get invert-assoc >alist natural-sort [
  40         first2
  41         natural-sort [ number>string ] map ", " join
  42         over exprs>vns get value-at expr>str
  43         "<%d> : {%s} (%s)\\l" sprintf
  44     ] map "" concat-as ;
  45
  46 : basic-block# ( -- n )
  47     basic-block get number>> ;
  48
  49 : add-gvns ( graph -- graph' )
  50     "gvns" [add-node
  51         congruence-classes =label
  52         "plaintext" =shape
  53     ];
  54     "gvns" 0 [add-edge "invis" =style ];
  55     basic-block# [add-node "bold" =style ];
  56     ;
  57
  58 SYMBOL: iteration
  59
  60 : iteration-dir ( -- path )
  61     iteration get number>string "gvn-iter" prepend ;
  62
  63 : new-iteration ( -- )
  64     iteration inc iteration-dir make-directories ;
  65
  66 : draw-annotated-cfg ( -- )
  67     iteration-dir [
  68         cfg get cfgviz add-gvns
  69         basic-block# number>string "bb" prepend svg
  70     ] with-directory ;
  71
  72 : annotate-gvn ( -- )
  73     \ value-numbering-iteration
  74     [ [ new-iteration ] prepend ] annotate
  75     \ value-numbering-step
  76     [ [ draw-annotated-cfg ] append ] annotate ;
  77
  78 : reset-gvn ( -- )
  79     \ value-numbering-iteration reset
  80     \ value-numbering-step reset ;
  81
  82 ! Replace compiler.cfg.value-numbering:value-numbering with
  83 ! compiler.cfg.gvn:value-numbering
  84
  85 : gvn-passes ( -- passes )
  86     \ optimize-cfg def>> [
  87         name>> "value-numbering" =
  88     ] split-when [ value-numbering ] join ;
  89
  90 : test-gvn ( path quot -- )
  91     gvn-passes passes [
  92         0 iteration [ watch-optimizer* ] with-variable
  93     ] with-variable ;
  94
  95 : watch-gvn ( path quot -- )
  96     annotate-gvn [ test-gvn ] [ reset-gvn ] finally ;
  97
  98 : watch-gvn-cfg ( path cfg -- )
  99     annotate-gvn [
 100         { value-numbering } passes [
 101             0 iteration [ watch-cfg ] with-variable
 102         ] with-variable
 103     ] [ reset-gvn ] finally ;
 104
 105 : watch-gvn-bb ( path insns -- )
 106     0 test-bb 0 get block>cfg watch-gvn-cfg ;