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