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