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