X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmmZipUtil.hs;h=5171218056a5415a7b3b0aa8202811981c54faed;hp=dce9e723430e71fc87d24d7014da4d8e668b3641;hb=e6243a818496aad82b6f47511d3bd9bc800f747d;hpb=25628e2771424cae1b3366322e8ce6f8a85440f9 diff --git a/compiler/cmm/CmmZipUtil.hs b/compiler/cmm/CmmZipUtil.hs index dce9e72..5171218 100644 --- a/compiler/cmm/CmmZipUtil.hs +++ b/compiler/cmm/CmmZipUtil.hs @@ -4,17 +4,16 @@ module CmmZipUtil , givesUniquePredecessorTo ) where +import BlockId import Prelude hiding (last, unzip) -import StackSlot import ZipCfg import Maybes -import UniqSet --- | Compute the predecessors of each *reachable* block +-- | 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 _) = + where add env block@(Block id _ _) = foldl (\env sid -> let preds = lookupBlockEnv env sid `orElse` emptyBlockSet in extendBlockEnv env sid (extendBlockSet preds id)) @@ -25,14 +24,14 @@ zipPreds g = foldl add emptyBlockEnv (postorder_dfs g) 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 + -- 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 - (delOneFromUniqSet single id, extendBlockSet multi id) + (removeBlockSet single id, extendBlockSet multi id) else (extendBlockSet single id, multi)