    module BlockId
      ( BlockId(..), mkBlockId 	-- ToDo: BlockId should be abstract, but it isn't yet
      , BlockEnv, emptyBlockEnv, elemBlockEnv, lookupBlockEnv, extendBlockEnv
      , mkBlockEnv, mapBlockEnv
      , eltsBlockEnv, plusBlockEnv, delFromBlockEnv, blockEnvToList, lookupWithDefaultBEnv
      , isNullBEnv, sizeBEnv, foldBlockEnv, foldBlockEnv', addToBEnv_Acc
      , BlockSet, emptyBlockSet, unitBlockSet, isEmptyBlockSet
      , elemBlockSet, extendBlockSet, sizeBlockSet, unionBlockSets
      , removeBlockSet, mkBlockSet, blockSetToList, foldBlockSet
      , blockLbl, infoTblLbl, retPtLbl
      ) where

    import CLabel
    import IdInfo
    import Maybes
    import Name
    import Outputable
    import UniqFM
    import Unique
    import UniqSet

    ----------------------------------------------------------------
    --- Block Ids, their environments, and their sets

    {- Note [Unique BlockId]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    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 entire
    compilation unit in which it appears.
    -}

    data BlockId = BlockId Unique
      deriving (Eq,Ord)

    instance Uniquable BlockId where
      getUnique (BlockId id) = id

    mkBlockId :: Unique -> BlockId
    mkBlockId uniq = BlockId uniq

    instance Show BlockId where
      show (BlockId u) = show u

    instance Outputable BlockId where
      ppr (BlockId id) = ppr id

    retPtLbl :: BlockId -> CLabel
    retPtLbl (BlockId id) = mkReturnPtLabel id

    blockLbl :: BlockId -> CLabel
    blockLbl (BlockId id) = mkEntryLabel (mkFCallName id "block") NoCafRefs

    infoTblLbl :: BlockId -> CLabel
    infoTblLbl (BlockId id) = mkInfoTableLabel (mkFCallName id "block") NoCafRefs

    -- Block environments: Id blocks
    newtype BlockEnv a = BlockEnv (UniqFM {- id -} a)

    instance Outputable a => Outputable (BlockEnv a) where
      ppr (BlockEnv env) = ppr env

    -- This is pretty horrid. There must be common patterns here that can be
    -- abstracted into wrappers.
    emptyBlockEnv :: BlockEnv a
    emptyBlockEnv = BlockEnv emptyUFM

    isNullBEnv :: BlockEnv a -> Bool
    isNullBEnv (BlockEnv env) = isNullUFM env

    sizeBEnv :: BlockEnv a -> Int
    sizeBEnv (BlockEnv env)  = sizeUFM env

    mkBlockEnv :: [(BlockId,a)] -> BlockEnv a
    mkBlockEnv = foldl (uncurry . extendBlockEnv) emptyBlockEnv

    eltsBlockEnv :: BlockEnv elt -> [elt]
    eltsBlockEnv (BlockEnv env) = eltsUFM env

    delFromBlockEnv	:: BlockEnv elt -> BlockId -> BlockEnv elt
    delFromBlockEnv	  (BlockEnv env) (BlockId id) = BlockEnv (delFromUFM env id)

    lookupBlockEnv :: BlockEnv a -> BlockId -> Maybe a
    lookupBlockEnv (BlockEnv env) (BlockId id) = lookupUFM env id

    elemBlockEnv :: BlockEnv a -> BlockId -> Bool
    elemBlockEnv (BlockEnv env) (BlockId id) = isJust $ lookupUFM env id

    lookupWithDefaultBEnv :: BlockEnv a -> a -> BlockId -> a
    lookupWithDefaultBEnv env x id = lookupBlockEnv env id `orElse` x

    extendBlockEnv :: BlockEnv a -> BlockId -> a -> BlockEnv a
    extendBlockEnv (BlockEnv env) (BlockId id) x = BlockEnv (addToUFM env id x)

    mapBlockEnv :: (a -> b) -> BlockEnv a -> BlockEnv b
    mapBlockEnv f (BlockEnv env) = BlockEnv (mapUFM f env)

    foldBlockEnv :: (BlockId -> a -> b -> b) -> b -> BlockEnv a -> b
    foldBlockEnv f b (BlockEnv env) =
      foldUFM_Directly (\u x y -> f (mkBlockId u) x y) b env

    foldBlockEnv' :: (a -> b -> b) -> b -> BlockEnv a -> b
    foldBlockEnv' f b (BlockEnv env) = foldUFM f b env

    plusBlockEnv :: BlockEnv elt -> BlockEnv elt -> BlockEnv elt
    plusBlockEnv (BlockEnv x) (BlockEnv y) = BlockEnv (plusUFM x y)

    blockEnvToList :: BlockEnv elt -> [(BlockId, elt)]
    blockEnvToList (BlockEnv env) =
      map (\ (id, elt) -> (BlockId id, elt)) $ ufmToList env

    addToBEnv_Acc	:: (elt -> elts -> elts)	-- Add to existing
    			   -> (elt -> elts)		-- New element
    			   -> BlockEnv elts 		-- old
    			   -> BlockId -> elt 		-- new
    			   -> BlockEnv elts		-- result
    addToBEnv_Acc add new (BlockEnv old) (BlockId k) v =
      BlockEnv (addToUFM_Acc add new old k v)
      -- I believe this is only used by obsolete code.

    newtype BlockSet = BlockSet (UniqSet Unique)
    instance Outputable BlockSet where
      ppr (BlockSet set) = ppr set

    emptyBlockSet :: BlockSet
    emptyBlockSet = BlockSet emptyUniqSet

    isEmptyBlockSet :: BlockSet -> Bool
    isEmptyBlockSet (BlockSet s) = isEmptyUniqSet s

    unitBlockSet :: BlockId -> BlockSet
    unitBlockSet = extendBlockSet emptyBlockSet

    elemBlockSet :: BlockId -> BlockSet -> Bool
    elemBlockSet (BlockId id) (BlockSet set) = elementOfUniqSet id set

    extendBlockSet :: BlockSet -> BlockId -> BlockSet
    extendBlockSet (BlockSet set) (BlockId id) = BlockSet (addOneToUniqSet set id)

    removeBlockSet :: BlockSet -> BlockId -> BlockSet
    removeBlockSet (BlockSet set) (BlockId id) = BlockSet (delOneFromUniqSet set id)

    mkBlockSet :: [BlockId] -> BlockSet
    mkBlockSet = foldl extendBlockSet emptyBlockSet

    unionBlockSets :: BlockSet -> BlockSet -> BlockSet
    unionBlockSets (BlockSet s) (BlockSet s') = BlockSet (unionUniqSets s s')

    sizeBlockSet :: BlockSet -> Int
    sizeBlockSet (BlockSet set) = sizeUniqSet set

    blockSetToList :: BlockSet -> [BlockId]
    blockSetToList (BlockSet set) = map BlockId $ uniqSetToList set

    foldBlockSet :: (BlockId -> b -> b) -> b -> BlockSet -> b
    foldBlockSet f z (BlockSet set) = foldUniqSet (f . BlockId) z set