basis/compiler/tree/dead-code/liveness/liveness.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: fry accessors namespaces assocs deques search-deques
   4 dlists kernel sequences compiler.utilities words sets
   5 stack-checker.branches compiler.tree compiler.tree.def-use
   6 compiler.tree.combinators ;
   7 IN: compiler.tree.dead-code.liveness
   8
   9 SYMBOL: work-list
  10
  11 SYMBOL: live-values
  12
  13 : live-value? ( value -- ? ) live-values get at ;
  14
  15 : look-at-value ( values -- ) work-list get push-front ;
  16
  17 : look-at-values ( values -- ) work-list get push-all-front ;
  18
  19 : look-at-inputs ( node -- ) in-d>> look-at-values ;
  20
  21 : init-dead-code ( -- )
  22     <hashed-dlist> work-list set
  23     H{ { +bottom+ f } } clone live-values set ;
  24
  25 GENERIC: mark-live-values* ( node -- )
  26
  27 : mark-live-values ( nodes -- nodes )
  28     dup [ mark-live-values* ] each-node ; inline
  29
  30 M: node mark-live-values* drop ;
  31
  32 GENERIC: compute-live-values* ( value node -- )
  33
  34 M: node compute-live-values* 2drop ;
  35
  36 : iterate-live-values ( value -- )
  37     dup live-values get key? [
  38         drop
  39     ] [
  40         dup live-values get conjoin
  41         dup defined-by compute-live-values*
  42     ] if ;
  43
  44 : compute-live-values ( -- )
  45     work-list get [ iterate-live-values ] slurp-deque ;
  46
  47 GENERIC: remove-dead-code* ( node -- node' )
  48
  49 M: node remove-dead-code* ;
  50
  51 : (remove-dead-code) ( nodes -- nodes' )
  52     [ remove-dead-code* ] map-flat ;