PrelRules: Handle Int left shifts of more than word-size bits
[ghc.git] / compiler / prelude / KnownUniques.hs
1 {-# LANGUAGE CPP #-}
2
3 -- | This is where we define a mapping from Uniques to their associated
4 -- known-key Names for things associated with tuples and sums. We use this
5 -- mapping while deserializing known-key Names in interface file symbol tables,
6 -- which are encoded as their Unique. See Note [Symbol table representation of
7 -- names] for details.
8 --
9
10 module KnownUniques
11 ( -- * Looking up known-key names
12 knownUniqueName
13
14 -- * Getting the 'Unique's of 'Name's
15 -- ** Anonymous sums
16 , mkSumTyConUnique
17 , mkSumDataConUnique
18 -- ** Tuples
19 -- *** Vanilla
20 , mkTupleTyConUnique
21 , mkTupleDataConUnique
22 -- *** Constraint
23 , mkCTupleTyConUnique
24 , mkCTupleDataConUnique
25 ) where
26
27 #include "HsVersions.h"
28
29 import GhcPrelude
30
31 import TysWiredIn
32 import TyCon
33 import DataCon
34 import Id
35 import BasicTypes
36 import Outputable
37 import Unique
38 import Name
39 import Util
40
41 import Data.Bits
42 import Data.Maybe
43
44 -- | Get the 'Name' associated with a known-key 'Unique'.
45 knownUniqueName :: Unique -> Maybe Name
46 knownUniqueName u =
47 case tag of
48 'z' -> Just $ getUnboxedSumName n
49 '4' -> Just $ getTupleTyConName Boxed n
50 '5' -> Just $ getTupleTyConName Unboxed n
51 '7' -> Just $ getTupleDataConName Boxed n
52 '8' -> Just $ getTupleDataConName Unboxed n
53 'k' -> Just $ getCTupleTyConName n
54 'm' -> Just $ getCTupleDataConUnique n
55 _ -> Nothing
56 where
57 (tag, n) = unpkUnique u
58
59 --------------------------------------------------
60 -- Anonymous sums
61 --
62 -- Sum arities start from 2. The encoding is a bit funny: we break up the
63 -- integral part into bitfields for the arity, an alternative index (which is
64 -- taken to be 0xff in the case of the TyCon), and, in the case of a datacon, a
65 -- tag (used to identify the sum's TypeRep binding).
66 --
67 -- This layout is chosen to remain compatible with the usual unique allocation
68 -- for wired-in data constructors described in Unique.hs
69 --
70 -- TyCon for sum of arity k:
71 -- 00000000 kkkkkkkk 11111100
72
73 -- TypeRep of TyCon for sum of arity k:
74 -- 00000000 kkkkkkkk 11111101
75 --
76 -- DataCon for sum of arity k and alternative n (zero-based):
77 -- 00000000 kkkkkkkk nnnnnn00
78 --
79 -- TypeRep for sum DataCon of arity k and alternative n (zero-based):
80 -- 00000000 kkkkkkkk nnnnnn10
81
82 mkSumTyConUnique :: Arity -> Unique
83 mkSumTyConUnique arity =
84 ASSERT(arity < 0x3f) -- 0x3f since we only have 6 bits to encode the
85 -- alternative
86 mkUnique 'z' (arity `shiftL` 8 .|. 0xfc)
87
88 mkSumDataConUnique :: ConTagZ -> Arity -> Unique
89 mkSumDataConUnique alt arity
90 | alt >= arity
91 = panic ("mkSumDataConUnique: " ++ show alt ++ " >= " ++ show arity)
92 | otherwise
93 = mkUnique 'z' (arity `shiftL` 8 + alt `shiftL` 2) {- skip the tycon -}
94
95 getUnboxedSumName :: Int -> Name
96 getUnboxedSumName n
97 | n .&. 0xfc == 0xfc
98 = case tag of
99 0x0 -> tyConName $ sumTyCon arity
100 0x1 -> getRep $ sumTyCon arity
101 _ -> pprPanic "getUnboxedSumName: invalid tag" (ppr tag)
102 | tag == 0x0
103 = dataConName $ sumDataCon (alt + 1) arity
104 | tag == 0x1
105 = getName $ dataConWrapId $ sumDataCon (alt + 1) arity
106 | tag == 0x2
107 = getRep $ promoteDataCon $ sumDataCon (alt + 1) arity
108 | otherwise
109 = pprPanic "getUnboxedSumName" (ppr n)
110 where
111 arity = n `shiftR` 8
112 alt = (n .&. 0xfc) `shiftR` 2
113 tag = 0x3 .&. n
114 getRep tycon =
115 fromMaybe (pprPanic "getUnboxedSumName(getRep)" (ppr tycon))
116 $ tyConRepName_maybe tycon
117
118 -- Note [Uniques for tuple type and data constructors]
119 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
120 --
121 -- Wired-in type constructor keys occupy *two* slots:
122 -- * u: the TyCon itself
123 -- * u+1: the TyConRepName of the TyCon
124 --
125 -- Wired-in tuple data constructor keys occupy *three* slots:
126 -- * u: the DataCon itself
127 -- * u+1: its worker Id
128 -- * u+2: the TyConRepName of the promoted TyCon
129
130 --------------------------------------------------
131 -- Constraint tuples
132
133 mkCTupleTyConUnique :: Arity -> Unique
134 mkCTupleTyConUnique a = mkUnique 'k' (2*a)
135
136 mkCTupleDataConUnique :: Arity -> Unique
137 mkCTupleDataConUnique a = mkUnique 'm' (3*a)
138
139 getCTupleTyConName :: Int -> Name
140 getCTupleTyConName n =
141 case n `divMod` 2 of
142 (arity, 0) -> cTupleTyConName arity
143 (arity, 1) -> mkPrelTyConRepName $ cTupleTyConName arity
144 _ -> panic "getCTupleTyConName: impossible"
145
146 getCTupleDataConUnique :: Int -> Name
147 getCTupleDataConUnique n =
148 case n `divMod` 3 of
149 (arity, 0) -> cTupleDataConName arity
150 (_arity, 1) -> panic "getCTupleDataConName: no worker"
151 (arity, 2) -> mkPrelTyConRepName $ cTupleDataConName arity
152 _ -> panic "getCTupleDataConName: impossible"
153
154 --------------------------------------------------
155 -- Normal tuples
156
157 mkTupleDataConUnique :: Boxity -> Arity -> Unique
158 mkTupleDataConUnique Boxed a = mkUnique '7' (3*a) -- may be used in C labels
159 mkTupleDataConUnique Unboxed a = mkUnique '8' (3*a)
160
161 mkTupleTyConUnique :: Boxity -> Arity -> Unique
162 mkTupleTyConUnique Boxed a = mkUnique '4' (2*a)
163 mkTupleTyConUnique Unboxed a = mkUnique '5' (2*a)
164
165 getTupleTyConName :: Boxity -> Int -> Name
166 getTupleTyConName boxity n =
167 case n `divMod` 2 of
168 (arity, 0) -> tyConName $ tupleTyCon boxity arity
169 (arity, 1) -> fromMaybe (panic "getTupleTyConName")
170 $ tyConRepName_maybe $ tupleTyCon boxity arity
171 _ -> panic "getTupleTyConName: impossible"
172
173 getTupleDataConName :: Boxity -> Int -> Name
174 getTupleDataConName boxity n =
175 case n `divMod` 3 of
176 (arity, 0) -> dataConName $ tupleDataCon boxity arity
177 (arity, 1) -> idName $ dataConWorkId $ tupleDataCon boxity arity
178 (arity, 2) -> fromMaybe (panic "getTupleDataCon")
179 $ tyConRepName_maybe $ promotedTupleDataCon boxity arity
180 _ -> panic "getTupleDataConName: impossible"