CLabel: Refactor pprDynamicLinkerAsmLabel
[ghc.git] / compiler / cmm / BlockId.hs
index feeacb5..73de69e 100644 (file)
@@ -1,21 +1,23 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
 {- 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
-  , BlockSet, BlockEnv
-  , IsSet(..), setInsertList, setDeleteList, setUnions
-  , IsMap(..), mapInsertList, mapDeleteList, mapUnions
-  , emptyBlockSet, emptyBlockMap
-  , blockLbl, infoTblLbl, retPtLbl
+  , newBlockId
+  , blockLbl, infoTblLbl
   ) where
 
+import GhcPrelude
+
 import CLabel
 import IdInfo
 import Name
-import Outputable
 import Unique
+import UniqSupply
 
-import Compiler.Hoopl as Hoopl hiding (Unique)
-import Compiler.Hoopl.GHC (uniqueToInt, uniqueToLbl, lblToUnique)
+import Hoopl.Label (Label, uniqueToLbl)
+import Hoopl.Unique (intToUnique)
 
 ----------------------------------------------------------------
 --- Block Ids, their environments, and their sets
@@ -29,40 +31,17 @@ most assembly languages allow, a label is visible throughout the entire
 compilation unit in which it appears.
 -}
 
-type BlockId = Hoopl.Label
-
-instance Uniquable BlockId where
-  getUnique label = getUnique (uniqueToInt $ lblToUnique label)
+type BlockId = Label
 
 mkBlockId :: Unique -> BlockId
 mkBlockId unique = uniqueToLbl $ intToUnique $ getKey unique
 
-instance Outputable BlockId where
-  ppr label = ppr (getUnique label)
-
-retPtLbl :: BlockId -> CLabel
-retPtLbl label = mkReturnPtLabel $ getUnique label
+newBlockId :: MonadUnique m => m BlockId
+newBlockId = mkBlockId <$> getUniqueM
 
 blockLbl :: BlockId -> CLabel
-blockLbl label = mkEntryLabel (mkFCallName (getUnique label) "block") NoCafRefs
+blockLbl label = mkLocalBlockLabel (getUnique label)
 
 infoTblLbl :: BlockId -> CLabel
-infoTblLbl label = mkInfoTableLabel (mkFCallName (getUnique label) "block") NoCafRefs
-
--- Block environments: Id blocks
-type BlockEnv a = Hoopl.LabelMap a
-
-instance Outputable a => Outputable (BlockEnv a) where
-  ppr = ppr . mapToList
-
-emptyBlockMap :: BlockEnv a
-emptyBlockMap = mapEmpty
-
--- Block sets
-type BlockSet = Hoopl.LabelSet
-
-instance Outputable BlockSet where
-  ppr = ppr . setElems
-
-emptyBlockSet :: BlockSet
-emptyBlockSet = setEmpty
+infoTblLbl label
+  = mkBlockInfoTableLabel (mkFCallName (getUnique label) "block") NoCafRefs