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