adding new files to do with new cmm functionality

[ghc-hetmet.git] / compiler / cmm / CmmZipUtil.hs

diff --git a/compiler/cmm/CmmZipUtil.hs b/compiler/cmm/CmmZipUtil.hs
new file mode 100644 (file)
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)