compiler/cmm/BlockId.hs

   1 module BlockId
   2   ( BlockId(..), mkBlockId      -- ToDo: BlockId should be abstract, but it isn't yet
   3   , BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv, mapBlockEnv
   4   , BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet, sizeBlockSet, mkBlockSet
   5   , foldBlockEnv, blockLbl, infoTblLbl
   6   ) where
   7
   8 import CLabel
   9 import IdInfo
  10 import Name
  11 import Outputable
  12 import UniqFM
  13 import Unique
  14 import UniqSet
  15
  16 ----------------------------------------------------------------
  17 --- Block Ids, their environments, and their sets
  18
  19 {- Note [Unique BlockId]
  20 ~~~~~~~~~~~~~~~~~~~~~~~~
  21 Although a 'BlockId' is a local label, for reasons of implementation,
  22 'BlockId's must be unique within an entire compilation unit.  The reason
  23 is that each local label is mapped to an assembly-language label, and in
  24 most assembly languages allow, a label is visible throughout the enitre
  25 compilation unit in which it appears.
  26 -}
  27
  28 newtype BlockId = BlockId Unique
  29   deriving (Eq,Ord)
  30
  31 instance Uniquable BlockId where
  32   getUnique (BlockId u) = u
  33
  34 mkBlockId :: Unique -> BlockId
  35 mkBlockId uniq = BlockId uniq
  36
  37 instance Show BlockId where
  38   show (BlockId u) = show u
  39
  40 instance Outputable BlockId where
  41   ppr = ppr . getUnique
  42
  43 blockLbl :: BlockId -> CLabel
  44 blockLbl id = mkEntryLabel (mkFCallName (getUnique id) "block") NoCafRefs
  45
  46 infoTblLbl :: BlockId -> CLabel
  47 infoTblLbl id = mkInfoTableLabel (mkFCallName (getUnique id) "block") NoCafRefs
  48
  49 type BlockEnv a = UniqFM {- BlockId -} a
  50 emptyBlockEnv :: BlockEnv a
  51 emptyBlockEnv = emptyUFM
  52 mkBlockEnv :: [(BlockId,a)] -> BlockEnv a
  53 mkBlockEnv = listToUFM
  54 lookupBlockEnv :: BlockEnv a -> BlockId -> Maybe a
  55 lookupBlockEnv = lookupUFM
  56 extendBlockEnv :: BlockEnv a -> BlockId -> a -> BlockEnv a
  57 extendBlockEnv = addToUFM
  58 mapBlockEnv :: (a -> b) -> BlockEnv a -> BlockEnv b
  59 mapBlockEnv = mapUFM
  60 foldBlockEnv :: (BlockId -> a -> b -> b) -> b -> BlockEnv a -> b
  61 foldBlockEnv f = foldUFM_Directly (\u x y -> f (mkBlockId u) x y)
  62
  63 type BlockSet = UniqSet BlockId
  64 emptyBlockSet :: BlockSet
  65 emptyBlockSet = emptyUniqSet
  66 elemBlockSet :: BlockId -> BlockSet -> Bool
  67 elemBlockSet = elementOfUniqSet
  68 extendBlockSet :: BlockSet -> BlockId -> BlockSet
  69 extendBlockSet = addOneToUniqSet
  70 mkBlockSet :: [BlockId] -> BlockSet
  71 mkBlockSet = mkUniqSet
  72 sizeBlockSet :: BlockSet -> Int
  73 sizeBlockSet = sizeUniqSet