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

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