compiler/cmm/CmmZipUtil.hs

   1
   2 module CmmZipUtil
   3   ( zipPreds
   4   , givesUniquePredecessorTo
   5   )
   6 where
   7 import BlockId
   8 import Prelude hiding (last, unzip)
   9 import ZipCfg
  10
  11 import Maybes
  12 import UniqSet
  13
  14 -- | Compute the predecessors of each *reachable* block
  15 zipPreds :: LastNode l => LGraph m l -> BlockEnv BlockSet
  16 zipPreds g = foldl add emptyBlockEnv (postorder_dfs g)
  17     where add env block@(Block id _) =
  18             foldl (\env sid ->
  19                        let preds = lookupBlockEnv env sid `orElse` emptyBlockSet
  20                        in  extendBlockEnv env sid (extendBlockSet preds id))
  21             env (succs block)
  22
  23 -- | Tell if a graph gives a block a unique predecessor.  For
  24 -- efficiency, this function is designed to be partially applied.
  25
  26 givesUniquePredecessorTo :: LastNode l => LGraph m l -> BlockId -> Bool
  27 givesUniquePredecessorTo g = \id -> elemBlockSet id singlePreds
  28     -- | accumulates a pair of sets: the set of all blocks containing a single
  29     -- predecessor, and the set of all blocks containing at least two predecessors
  30     where (singlePreds, _) = fold_blocks add (emptyBlockSet, emptyBlockSet) g
  31           add b (single, multi) = foldl add_pred (single, multi) (succs b)
  32           add_pred pair@(single, multi) id =
  33               if elemBlockSet id multi then pair
  34               else if elemBlockSet id single then
  35                        (delOneFromUniqSet single id, extendBlockSet multi id)
  36                    else
  37                        (extendBlockSet single id, multi)
  38
  39
  40