basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs deques dlists kernel locals sequences lexer
   4 namespaces functors compiler.cfg.rpo compiler.cfg.utilities
   5 compiler.cfg.predecessors compiler.cfg ;
   6 IN: compiler.cfg.dataflow-analysis
   7
   8 GENERIC: join-sets ( sets bb dfa -- set )
   9 GENERIC: transfer-set ( in-set bb dfa -- out-set )
  10 GENERIC: block-order ( cfg dfa -- bbs )
  11 GENERIC: successors ( bb dfa -- seq )
  12 GENERIC: predecessors ( bb dfa -- seq )
  13
  14 <PRIVATE
  15
  16 MIXIN: dataflow-analysis
  17
  18 : <dfa-worklist> ( cfg dfa -- queue )
  19     block-order <hashed-dlist> [ push-all-front ] keep ;
  20
  21 GENERIC# compute-in-set 2 ( bb out-sets dfa -- set )
  22
  23 M: kill-block compute-in-set 3drop f ;
  24
  25 M:: basic-block compute-in-set ( bb out-sets dfa -- set )
  26     ! Only consider initialized sets.
  27     bb dfa predecessors
  28     [ out-sets key? ] filter
  29     [ out-sets at ] map
  30     bb dfa join-sets ;
  31
  32 :: update-in-set ( bb in-sets out-sets dfa -- ? )
  33     bb out-sets dfa compute-in-set
  34     bb in-sets maybe-set-at ; inline
  35
  36 GENERIC# compute-out-set 2 ( bb out-sets dfa -- set )
  37
  38 M: kill-block compute-out-set 3drop f ;
  39
  40 M:: basic-block compute-out-set ( bb in-sets dfa -- set )
  41     bb in-sets at bb dfa transfer-set ;
  42
  43 :: update-out-set ( bb in-sets out-sets dfa -- ? )
  44     bb in-sets dfa compute-out-set
  45     bb out-sets maybe-set-at ; inline
  46
  47 :: dfa-step ( bb in-sets out-sets dfa work-list -- )
  48     bb in-sets out-sets dfa update-in-set [
  49         bb in-sets out-sets dfa update-out-set [
  50             bb dfa successors work-list push-all-front
  51         ] when
  52     ] when ; inline
  53
  54 :: run-dataflow-analysis ( cfg dfa -- in-sets out-sets )
  55     cfg needs-predecessors drop
  56     H{ } clone :> in-sets
  57     H{ } clone :> out-sets
  58     cfg dfa <dfa-worklist> :> work-list
  59     work-list [ in-sets out-sets dfa work-list dfa-step ] slurp-deque
  60     in-sets
  61     out-sets ; inline
  62
  63 M: dataflow-analysis join-sets 2drop assoc-refine ;
  64
  65 FUNCTOR: define-analysis ( name -- )
  66
  67 name-analysis DEFINES-CLASS ${name}-analysis
  68 name-ins DEFINES ${name}-ins
  69 name-outs DEFINES ${name}-outs
  70 name-in DEFINES ${name}-in
  71 name-out DEFINES ${name}-out
  72
  73 WHERE
  74
  75 SINGLETON: name-analysis
  76
  77 SYMBOL: name-ins
  78
  79 : name-in ( bb -- set ) name-ins get at ;
  80
  81 SYMBOL: name-outs
  82
  83 : name-out ( bb -- set ) name-outs get at ;
  84
  85 ;FUNCTOR
  86
  87 ! ! ! Forward dataflow analysis
  88
  89 MIXIN: forward-analysis
  90 INSTANCE: forward-analysis dataflow-analysis
  91
  92 M: forward-analysis block-order  drop reverse-post-order ;
  93 M: forward-analysis successors   drop successors>> ;
  94 M: forward-analysis predecessors drop predecessors>> ;
  95
  96 FUNCTOR: define-forward-analysis ( name -- )
  97
  98 name-analysis IS ${name}-analysis
  99 name-ins IS ${name}-ins
 100 name-outs IS ${name}-outs
 101 compute-name-sets DEFINES compute-${name}-sets
 102
 103 WHERE
 104
 105 INSTANCE: name-analysis forward-analysis
 106
 107 : compute-name-sets ( cfg -- )
 108     name-analysis run-dataflow-analysis
 109     [ name-ins set ] [ name-outs set ] bi* ;
 110
 111 ;FUNCTOR
 112
 113 ! ! ! Backward dataflow analysis
 114
 115 MIXIN: backward-analysis
 116 INSTANCE: backward-analysis dataflow-analysis
 117
 118 M: backward-analysis block-order  drop post-order ;
 119 M: backward-analysis successors   drop predecessors>> ;
 120 M: backward-analysis predecessors drop successors>> ;
 121
 122 FUNCTOR: define-backward-analysis ( name -- )
 123
 124 name-analysis IS ${name}-analysis
 125 name-ins IS ${name}-ins
 126 name-outs IS ${name}-outs
 127 compute-name-sets DEFINES compute-${name}-sets
 128
 129 WHERE
 130
 131 INSTANCE: name-analysis backward-analysis
 132
 133 : compute-name-sets ( cfg -- )
 134     \ name-analysis run-dataflow-analysis
 135     [ name-outs set ] [ name-ins set ] bi* ;
 136
 137 ;FUNCTOR
 138
 139 PRIVATE>
 140
 141 SYNTAX: FORWARD-ANALYSIS:
 142     scan [ define-analysis ] [ define-forward-analysis ] bi ;
 143
 144 SYNTAX: BACKWARD-ANALYSIS:
 145     scan [ define-analysis ] [ define-backward-analysis ] bi ;