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

diff --git a/compiler/cmm/BlockId.hs b/compiler/cmm/BlockId.hs
index 2e4d452..c28201c 100644
--- a/compiler/cmm/BlockId.hs
+++ b/compiler/cmm/BlockId.hs
@@ -1,17 +1,21 @@
+{- BlockId module should probably go away completely, being superseded by Label -}
 module BlockId
-  ( BlockId(..), mkBlockId 	-- ToDo: BlockId should be abstract, but it isn't yet
-  , BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv, mapBlockEnv
-  , BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet, sizeBlockSet, mkBlockSet
-  , foldBlockEnv, blockLbl, infoTblLbl
+  ( BlockId, mkBlockId -- ToDo: BlockId should be abstract, but it isn't yet
+  , BlockSet, BlockEnv
+  , IsSet(..), setInsertList, setDeleteList, setUnions
+  , IsMap(..), mapInsertList, mapDeleteList, mapUnions
+  , emptyBlockSet, emptyBlockMap
+  , blockLbl, infoTblLbl, retPtLbl
   ) where
 
 import CLabel
 import IdInfo
 import Name
 import Outputable
-import UniqFM
 import Unique
-import UniqSet
+
+import Compiler.Hoopl hiding (Unique)
+import Compiler.Hoopl.GHC (uniqueToInt, uniqueToLbl, lblToUnique)
 
 ----------------------------------------------------------------
 --- Block Ids, their environments, and their sets
@@ -21,53 +25,44 @@ import UniqSet
 Although a 'BlockId' is a local label, for reasons of implementation,
 'BlockId's must be unique within an entire compilation unit.  The reason
 is that each local label is mapped to an assembly-language label, and in
-most assembly languages allow, a label is visible throughout the enitre
+most assembly languages allow, a label is visible throughout the entire
 compilation unit in which it appears.
 -}
 
-newtype BlockId = BlockId Unique
-  deriving (Eq,Ord)
+type BlockId = Label
 
 instance Uniquable BlockId where
-  getUnique (BlockId u) = u
+  getUnique label = getUnique (uniqueToInt $ lblToUnique label)
 
 mkBlockId :: Unique -> BlockId
-mkBlockId uniq = BlockId uniq
-
-instance Show BlockId where
-  show (BlockId u) = show u
+mkBlockId unique = uniqueToLbl $ intToUnique $ getKey unique
 
 instance Outputable BlockId where
-  ppr = ppr . getUnique
+  ppr label = ppr (getUnique label)
+
+retPtLbl :: BlockId -> CLabel
+retPtLbl label = mkReturnPtLabel $ getUnique label
 
 blockLbl :: BlockId -> CLabel
-blockLbl id = mkEntryLabel (mkFCallName (getUnique id) "block") NoCafRefs
+blockLbl label = mkEntryLabel (mkFCallName (getUnique label) "block") NoCafRefs
 
 infoTblLbl :: BlockId -> CLabel
-infoTblLbl id = mkInfoTableLabel (mkFCallName (getUnique id) "block") NoCafRefs
-
-type BlockEnv a = UniqFM {- BlockId -} a
-emptyBlockEnv :: BlockEnv a
-emptyBlockEnv = emptyUFM
-mkBlockEnv :: [(BlockId,a)] -> BlockEnv a
-mkBlockEnv = listToUFM
-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
+infoTblLbl label = mkInfoTableLabel (mkFCallName (getUnique label) "block") NoCafRefs
+
+-- Block environments: Id blocks
+type BlockEnv a = LabelMap a
+
+instance Outputable a => Outputable (BlockEnv a) where
+  ppr = ppr . mapToList
+
+emptyBlockMap :: BlockEnv a
+emptyBlockMap = mapEmpty
+
+-- Block sets
+type BlockSet = LabelSet
+
+instance Outputable BlockSet where
+  ppr = ppr . setElems
+
 emptyBlockSet :: BlockSet
-emptyBlockSet = emptyUniqSet
-elemBlockSet :: BlockId -> BlockSet -> Bool
-elemBlockSet = elementOfUniqSet
-extendBlockSet :: BlockSet -> BlockId -> BlockSet
-extendBlockSet = addOneToUniqSet
-mkBlockSet :: [BlockId] -> BlockSet
-mkBlockSet = mkUniqSet
-sizeBlockSet :: BlockSet -> Int
-sizeBlockSet = sizeUniqSet
+emptyBlockSet = setEmpty