compiler/cmm/BlockId.hs

   1 {- BlockId module should probably go away completely, being superseded by Label -}
   2 module BlockId
   3   ( BlockId, mkBlockId -- ToDo: BlockId should be abstract, but it isn't yet
   4   , BlockSet, BlockEnv
   5   , IsSet(..), setInsertList, setDeleteList, setUnions
   6   , IsMap(..), mapInsertList, mapDeleteList, mapUnions
   7   , emptyBlockSet, emptyBlockMap
   8   , blockLbl, infoTblLbl, retPtLbl
   9   ) where
  10
  11 import CLabel
  12 import IdInfo
  13 import Name
  14 import Outputable
  15 import Unique
  16
  17 import Compiler.Hoopl hiding (Unique)
  18 import Compiler.Hoopl.GHC (uniqueToInt, uniqueToLbl, lblToUnique)
  19
  20 ----------------------------------------------------------------
  21 --- Block Ids, their environments, and their sets
  22
  23 {- Note [Unique BlockId]
  24 ~~~~~~~~~~~~~~~~~~~~~~~~
  25 Although a 'BlockId' is a local label, for reasons of implementation,
  26 'BlockId's must be unique within an entire compilation unit.  The reason
  27 is that each local label is mapped to an assembly-language label, and in
  28 most assembly languages allow, a label is visible throughout the entire
  29 compilation unit in which it appears.
  30 -}
  31
  32 type BlockId = Label
  33
  34 instance Uniquable BlockId where
  35   getUnique label = getUnique (uniqueToInt $ lblToUnique label)
  36
  37 mkBlockId :: Unique -> BlockId
  38 mkBlockId unique = uniqueToLbl $ intToUnique $ getKey unique
  39
  40 instance Outputable BlockId where
  41   ppr label = ppr (getUnique label)
  42
  43 retPtLbl :: BlockId -> CLabel
  44 retPtLbl label = mkReturnPtLabel $ getUnique label
  45
  46 blockLbl :: BlockId -> CLabel
  47 blockLbl label = mkEntryLabel (mkFCallName (getUnique label) "block") NoCafRefs
  48
  49 infoTblLbl :: BlockId -> CLabel
  50 infoTblLbl label = mkInfoTableLabel (mkFCallName (getUnique label) "block") NoCafRefs
  51
  52 -- Block environments: Id blocks
  53 type BlockEnv a = LabelMap a
  54
  55 instance Outputable a => Outputable (BlockEnv a) where
  56   ppr = ppr . mapToList
  57
  58 emptyBlockMap :: BlockEnv a
  59 emptyBlockMap = mapEmpty
  60
  61 -- Block sets
  62 type BlockSet = LabelSet
  63
  64 instance Outputable BlockSet where
  65   ppr = ppr . setElems
  66
  67 emptyBlockSet :: BlockSet
  68 emptyBlockSet = setEmpty