X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmZipUtil.hs;fp=compiler%2Fcmm%2FCmmZipUtil.hs;h=2dcb55fe2ef0526563f115435d022bf32d1d7967;hb=8b7eaa404043294bd4cb4a0322ac1f7115bad6a0;hp=0000000000000000000000000000000000000000;hpb=bd50bd07d54631d802598b6fb9a6f468afa823cf;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmZipUtil.hs b/compiler/cmm/CmmZipUtil.hs
new file mode 100644
index 0000000..2dcb55f
--- /dev/null
+++ b/compiler/cmm/CmmZipUtil.hs
@@ -0,0 +1,17 @@
+{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
+module CmmZipUtil 
+  ( zipPreds
+  )
+where
+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)