module CmmZipUtil
  ( zipPreds
  , givesUniquePredecessorTo
  )
where
import BlockId
import Prelude hiding (last, unzip)
import ZipCfg

import Maybes

-- | Compute the predecessors of each /reachable/ block
zipPreds :: LastNode l => LGraph m l -> BlockEnv BlockSet
zipPreds g = foldl add emptyBlockEnv (postorder_dfs g)
    where add env block@(Block id _) =
            foldl (\env sid ->
                       let preds = lookupBlockEnv env sid `orElse` emptyBlockSet
                       in  extendBlockEnv env sid (extendBlockSet preds id))
            env (succs block)

-- | Tell if a graph gives a block a unique predecessor.  For
-- efficiency, this function is designed to be partially applied.

givesUniquePredecessorTo :: LastNode l => LGraph m l -> BlockId -> Bool
givesUniquePredecessorTo g = \id -> elemBlockSet id singlePreds
    -- accumulates a pair of sets: the set of all blocks containing a single
    -- predecessor, and the set of all blocks containing at least two predecessors
    where (singlePreds, _) = fold_blocks add (emptyBlockSet, emptyBlockSet) g
          add b (single, multi) = foldl add_pred (single, multi) (succs b)
          add_pred pair@(single, multi) id =
              if elemBlockSet id multi then pair
              else if elemBlockSet id single then
                       (removeBlockSet single id, extendBlockSet multi id)
                   else
                       (extendBlockSet single id, multi)