X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FBlockId.hs;h=2e4d452e7518f734738e4fb374d0beb08335cf26;hp=fb9b7cab8fb495df7747b6c157e07cea7207bb22;hb=176fa33f17dd78355cc572e006d2ab26898e2c69;hpb=0d80489c9b9f2421f65d8dd86c1e50c6bb429715

diff --git a/compiler/cmm/BlockId.hs b/compiler/cmm/BlockId.hs
index fb9b7ca..2e4d452 100644
--- a/compiler/cmm/BlockId.hs
+++ b/compiler/cmm/BlockId.hs
@@ -1,9 +1,13 @@
 module BlockId
   ( BlockId(..), mkBlockId 	-- ToDo: BlockId should be abstract, but it isn't yet
-  , BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv
+  , BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv, mapBlockEnv
   , BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet, sizeBlockSet, mkBlockSet
+  , foldBlockEnv, blockLbl, infoTblLbl
   ) where
 
+import CLabel
+import IdInfo
+import Name
 import Outputable
 import UniqFM
 import Unique
@@ -36,6 +40,11 @@ instance Show BlockId where
 instance Outputable BlockId where
   ppr = ppr . getUnique
 
+blockLbl :: BlockId -> CLabel
+blockLbl id = mkEntryLabel (mkFCallName (getUnique id) "block") NoCafRefs
+
+infoTblLbl :: BlockId -> CLabel
+infoTblLbl id = mkInfoTableLabel (mkFCallName (getUnique id) "block") NoCafRefs
 
 type BlockEnv a = UniqFM {- BlockId -} a
 emptyBlockEnv :: BlockEnv a
@@ -46,6 +55,10 @@ lookupBlockEnv :: BlockEnv a -> BlockId -> Maybe a
 lookupBlockEnv = lookupUFM
 extendBlockEnv :: BlockEnv a -> BlockId -> a -> BlockEnv a
 extendBlockEnv = addToUFM
+mapBlockEnv :: (a -> b) -> BlockEnv a -> BlockEnv b
+mapBlockEnv = mapUFM
+foldBlockEnv :: (BlockId -> a -> b -> b) -> b -> BlockEnv a -> b
+foldBlockEnv f = foldUFM_Directly (\u x y -> f (mkBlockId u) x y)
 
 type BlockSet = UniqSet BlockId
 emptyBlockSet :: BlockSet