core/optimizer/backend/backend.factor

   1 ! Copyright (C) 2004, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays generic assocs inference inference.class
   4 inference.dataflow inference.backend inference.state io kernel
   5 math namespaces sequences vectors words quotations hashtables
   6 combinators classes optimizer.def-use accessors ;
   7 IN: optimizer.backend
   8
   9 SYMBOL: class-substitutions
  10
  11 SYMBOL: literal-substitutions
  12
  13 SYMBOL: value-substitutions
  14
  15 SYMBOL: optimizer-changed
  16
  17 GENERIC: optimize-node* ( node -- node/t changed? )
  18
  19 : ?union ( assoc assoc/f -- assoc' )
  20     dup assoc-empty? [ drop ] [ swap assoc-union ] if ;
  21
  22 : add-node-literals ( node assoc -- )
  23     [ ?union ] curry change-literals drop ;
  24
  25 : add-node-classes ( node assoc -- )
  26     [ ?union ] curry change-classes drop ;
  27
  28 : substitute-values ( node assoc -- )
  29     dup assoc-empty? [
  30         2drop
  31     ] [
  32         {
  33             [ >r  in-d>> r> substitute-here ]
  34             [ >r  in-r>> r> substitute-here ]
  35             [ >r out-d>> r> substitute-here ]
  36             [ >r out-r>> r> substitute-here ]
  37         } 2cleave
  38     ] if ;
  39
  40 : perform-substitutions ( node -- )
  41     [   class-substitutions get add-node-classes  ]
  42     [ literal-substitutions get add-node-literals ]
  43     [   value-substitutions get substitute-values ]
  44     tri ;
  45
  46 DEFER: optimize-nodes
  47
  48 : optimize-children ( node -- )
  49     [ optimize-nodes ] map-children ;
  50
  51 : optimize-node ( node -- node )
  52     dup [
  53         dup perform-substitutions
  54         dup optimize-node* [
  55             nip optimizer-changed on optimize-node
  56         ] [
  57             dup t eq? [
  58                 drop dup optimize-children
  59             ] [
  60                 nip optimize-node
  61             ] if
  62         ] if
  63     ] when ;
  64
  65 : optimize-nodes ( node -- newnode )
  66     [
  67         class-substitutions [ clone ] change
  68         literal-substitutions [ clone ] change
  69         [ optimize-node ] transform-nodes
  70         optimizer-changed get
  71     ] with-scope optimizer-changed set ;
  72
  73 M: node optimize-node* drop t f ;
  74
  75 ! Post-inlining cleanup
  76 : follow ( key assoc -- value )
  77     2dup at* [ swap follow nip ] [ 2drop ] if ;
  78
  79 : union* ( assoc1 assoc2 -- assoc )
  80     assoc-union [ keys ] keep
  81     [ dupd follow ] curry
  82     H{ } map>assoc ;
  83
  84 : update* ( assoc1 assoc2 -- )
  85     #! Not very efficient.
  86     dupd union* update ;
  87
  88 : compute-value-substitutions ( #call/#merge #return/#values -- assoc )
  89     [ out-d>> ] [ in-d>> ] bi* 2array unify-lengths flip
  90     [ = not ] assoc-filter >hashtable ;
  91
  92 : cleanup-inlining ( #return/#values -- newnode changed? )
  93     dup node-successor [
  94         [ node-successor ] keep
  95         {
  96             [ nip classes>> class-substitutions get swap update ]
  97             [ nip literals>> literal-substitutions get swap update ]
  98             [ compute-value-substitutions value-substitutions get swap update* ]
  99             [ drop node-successor ]
 100         } 2cleave t
 101     ] [
 102         drop t f
 103     ] if ;
 104
 105 ! #return
 106 M: #return optimize-node* cleanup-inlining ;
 107
 108 ! #values
 109 M: #values optimize-node* cleanup-inlining ;
 110
 111 M: f set-node-successor 2drop ;
 112
 113 : splice-node ( old new -- )
 114     dup splice-def-use last-node set-node-successor ;
 115
 116 : drop-inputs ( node -- #shuffle )
 117     node-in-d clone \ #shuffle in-node ;
 118
 119 : optimizer-hooks ( node -- conditions )
 120     param>> "optimizer-hooks" word-prop ;
 121
 122 : optimizer-hook ( node -- pair/f )
 123     dup optimizer-hooks [ first call ] find 2nip ;
 124
 125 : optimize-hook ( node -- )
 126     dup optimizer-hook second call ;
 127
 128 : define-optimizers ( word optimizers -- )
 129     "optimizer-hooks" set-word-prop ;