module BlockId
( BlockId(..), mkBlockId
, 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
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
newtype BlockEnv a = BlockEnv (UniqFM a)
instance Outputable a => Outputable (BlockEnv a) where
ppr (BlockEnv env) = ppr env
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)
-> (elt -> elts)
-> BlockEnv elts
-> BlockId -> elt
-> BlockEnv elts
addToBEnv_Acc add new (BlockEnv old) (BlockId k) v =
BlockEnv (addToUFM_Acc add new old k v)
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