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

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays compiler.tree
   4 compiler.tree.dead-code.branches
   5 compiler.tree.dead-code.liveness compiler.tree.dead-code.simple
   6 compiler.tree.recursive kernel locals sequences
   7 stack-checker.backend ;
   8 IN: compiler.tree.dead-code.recursive
   9
  10 M: #enter-recursive compute-live-values*
  11     ! If the output of an #enter-recursive is live, then the
  12     ! corresponding inputs to the #call-recursive are live also.
  13     [ out-d>> ] [ recursive-phi-in ] bi look-at-phi ;
  14
  15 M: #return-recursive compute-live-values*
  16     [ out-d>> ] [ in-d>> ] bi look-at-mapping ;
  17
  18 M: #call-recursive compute-live-values*
  19     ! If the output of a #call-recursive is live, then the
  20     ! corresponding inputs to #return nodes are live also.
  21     [ out-d>> ] [ label>> return>> in-d>> ] bi look-at-mapping ;
  22
  23 :: drop-dead-inputs ( inputs outputs -- #shuffle )
  24     inputs filter-live
  25     outputs inputs filter-corresponding length make-values
  26     outputs
  27     inputs
  28     drop-values ;
  29
  30 M: #enter-recursive remove-dead-code*
  31     [ filter-live ] change-out-d ;
  32
  33 : drop-call-recursive-inputs ( node -- #shuffle )
  34     dup [ in-d>> ] [ label>> enter-out>> ] bi drop-dead-inputs
  35     [ out-d>> >>in-d drop ]
  36     [ nip ]
  37     2bi ;
  38
  39 :: (drop-call-recursive-outputs) ( inputs outputs -- #shuffle )
  40     inputs outputs filter-corresponding length make-values :> new-live-outputs
  41     outputs filter-live :> live-outputs
  42     new-live-outputs
  43     live-outputs
  44     live-outputs
  45     new-live-outputs
  46     drop-values ;
  47
  48 : drop-call-recursive-outputs ( node -- #shuffle )
  49     dup [ label>> return>> in-d>> ] [ out-d>> ] bi
  50     (drop-call-recursive-outputs)
  51     [ in-d>> >>out-d drop ] keep ;
  52
  53 M: #call-recursive remove-dead-code*
  54     [ drop-call-recursive-inputs ]
  55     [ ]
  56     [ drop-call-recursive-outputs ]
  57     tri 3array ;
  58
  59 :: drop-recursive-inputs ( node -- shuffle )
  60     node [ in-d>> ] [ label>> enter-out>> ] bi drop-dead-inputs :> shuffle
  61     shuffle out-d>> :> new-outputs
  62     node new-outputs
  63     [ [ label>> enter-recursive>> ] dip >>in-d drop ] [ >>in-d drop ] 2bi
  64     shuffle ;
  65
  66 :: drop-recursive-outputs ( node -- shuffle )
  67     node label>> return>> :> return
  68     return in-d>> filter-live :> new-inputs
  69     return [ in-d>> ] [ out-d>> ] bi filter-corresponding :> new-outputs
  70     return
  71     [ new-inputs >>in-d new-outputs >>out-d drop ]
  72     [ drop-dead-outputs ]
  73     bi ;
  74
  75 M: #recursive remove-dead-code* ( node -- nodes )
  76     [ drop-recursive-inputs ]
  77     [
  78         [ (remove-dead-code) ] change-child
  79         dup label>> [ filter-live ] change-enter-out drop
  80     ]
  81     [ drop-recursive-outputs ] tri 3array ;
  82
  83 M: #return-recursive remove-dead-code* ;