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

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