basis/compiler/tree/propagation/copy/copy.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: namespaces sequences assocs math kernel accessors fry
   4 combinators sets locals columns
   5 stack-checker.branches
   6 compiler.tree
   7 compiler.tree.def-use
   8 compiler.tree.combinators ;
   9 IN: compiler.tree.propagation.copy
  10
  11 ! Two values are copy-equivalent if they are always identical
  12 ! at run-time ("DS" relation). This is just a weak form of
  13 ! value numbering.
  14
  15 ! Mapping from values to their canonical leader
  16 SYMBOL: copies
  17
  18 :: compress-path ( source assoc -- destination )
  19     [let | destination [ source assoc at ] |
  20         source destination = [ source ] [
  21             [let | destination' [ destination assoc compress-path ] |
  22                 destination' destination = [
  23                     destination' source assoc set-at
  24                 ] unless
  25                 destination'
  26             ]
  27         ] if
  28     ] ;
  29
  30 : resolve-copy ( copy -- val ) copies get compress-path ;
  31
  32 : is-copy-of ( val copy -- ) copies get set-at ;
  33
  34 : are-copies-of ( vals copies -- ) [ is-copy-of ] 2each ;
  35
  36 : introduce-value ( val -- ) copies get conjoin ;
  37
  38 GENERIC: compute-copy-equiv* ( node -- )
  39
  40 M: #renaming compute-copy-equiv* inputs/outputs are-copies-of ;
  41
  42 : compute-phi-equiv ( inputs outputs -- )
  43     #! An output is a copy of every input if all inputs are
  44     #! copies of the same original value.
  45     [
  46         swap remove-bottom [ resolve-copy ] map
  47         dup [ all-equal? ] [ empty? not ] bi and
  48         [ first swap is-copy-of ] [ 2drop ] if
  49     ] 2each ;
  50
  51 M: #phi compute-copy-equiv*
  52     [ phi-in-d>> flip ] [ out-d>> ] bi compute-phi-equiv ;
  53
  54 M: node compute-copy-equiv* drop ;
  55
  56 : compute-copy-equiv ( node -- )
  57     [ node-defs-values [ introduce-value ] each ]
  58     [ compute-copy-equiv* ]
  59     bi ;