4 , givesUniquePredecessorTo
8 import Prelude hiding (last, unzip)
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 _) =
19 let preds = lookupBlockEnv env sid `orElse` emptyBlockSet
20 in extendBlockEnv env sid (extendBlockSet preds id))
23 -- | Tell if a graph gives a block a unique predecessor. For
24 -- efficiency, this function is designed to be partially applied.
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)
37 (extendBlockSet single id, multi)