Merge in new code generator branch.
[ghc.git] / 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