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

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