| ... |
... |
@@ -104,30 +104,30 @@ This layout is chosen to remain compatible with the usual unique allocation |
|
104
|
104
|
for wired-in data constructors described in GHC.Types.Unique
|
|
105
|
105
|
|
|
106
|
106
|
TyCon for sum of arity k:
|
|
107
|
|
- 00000000 kkkkkkkk 11111100
|
|
|
107
|
+ 00kkkkkk kkkkkkkk 11111111 11111100
|
|
108
|
108
|
|
|
109
|
109
|
TypeRep of TyCon for sum of arity k:
|
|
110
|
|
- 00000000 kkkkkkkk 11111101
|
|
|
110
|
+ 00kkkkkk kkkkkkkk 11111111 11111101
|
|
111
|
111
|
|
|
112
|
112
|
DataCon for sum of arity k and alternative n (zero-based):
|
|
113
|
|
- 00000000 kkkkkkkk nnnnnn00
|
|
|
113
|
+ 00kkkkkk kkkkkkkk nnnnnnnn nnnnnn00
|
|
114
|
114
|
|
|
115
|
115
|
TypeRep for sum DataCon of arity k and alternative n (zero-based):
|
|
116
|
|
- 00000000 kkkkkkkk nnnnnn10
|
|
|
116
|
+ 00kkkkkk kkkkkkkk nnnnnnnn nnnnnn10
|
|
117
|
117
|
-}
|
|
118
|
118
|
|
|
119
|
119
|
mkSumTyConUnique :: Arity -> Unique
|
|
120
|
120
|
mkSumTyConUnique arity =
|
|
121
|
|
- assertPpr (arity <= 0x3f) (ppr arity) $
|
|
122
|
|
- -- 0x3f since we only have 6 bits to encode the
|
|
|
121
|
+ assertPpr (arity <= 0x3fff) (ppr arity) $
|
|
|
122
|
+ -- 0x3fff since we only have 14 bits to encode the
|
|
123
|
123
|
-- alternative
|
|
124
|
|
- mkUniqueInt 'z' (arity `shiftL` 8 .|. 0xfc)
|
|
|
124
|
+ mkUniqueInt 'z' (arity `shiftL` 16 .|. 0xfffc)
|
|
125
|
125
|
|
|
126
|
126
|
-- | Inverse of 'mkSumTyConUnique'
|
|
127
|
127
|
isSumTyConUnique :: Unique -> Maybe Arity
|
|
128
|
128
|
isSumTyConUnique u =
|
|
129
|
|
- case (tag, n .&. 0xfc) of
|
|
130
|
|
- ('z', 0xfc) -> Just (word64ToInt n `shiftR` 8)
|
|
|
129
|
+ case (tag, n .&. 0xfffc) of
|
|
|
130
|
+ ('z', 0xfffc) -> Just (word64ToInt n `shiftR` 16)
|
|
131
|
131
|
_ -> Nothing
|
|
132
|
132
|
where
|
|
133
|
133
|
(tag, n) = unpkUnique u
|
| ... |
... |
@@ -137,11 +137,11 @@ mkSumDataConUnique alt arity |
|
137
|
137
|
| alt >= arity
|
|
138
|
138
|
= panic ("mkSumDataConUnique: " ++ show alt ++ " >= " ++ show arity)
|
|
139
|
139
|
| otherwise
|
|
140
|
|
- = mkUniqueInt 'z' (arity `shiftL` 8 + alt `shiftL` 2) {- skip the tycon -}
|
|
|
140
|
+ = mkUniqueInt 'z' (arity `shiftL` 16 + alt `shiftL` 2) {- skip the tycon -}
|
|
141
|
141
|
|
|
142
|
142
|
getUnboxedSumName :: Int -> Name
|
|
143
|
143
|
getUnboxedSumName n
|
|
144
|
|
- | n .&. 0xfc == 0xfc
|
|
|
144
|
+ | n .&. 0xfffc == 0xfffc
|
|
145
|
145
|
= case tag of
|
|
146
|
146
|
0x0 -> tyConName $ sumTyCon arity
|
|
147
|
147
|
0x1 -> getRep $ sumTyCon arity
|
| ... |
... |
@@ -155,7 +155,7 @@ getUnboxedSumName n |
|
155
|
155
|
| otherwise
|
|
156
|
156
|
= pprPanic "getUnboxedSumName" (ppr n)
|
|
157
|
157
|
where
|
|
158
|
|
- arity = n `shiftR` 8
|
|
|
158
|
+ arity = n `shiftR` 16
|
|
159
|
159
|
alt = (n .&. 0xfc) `shiftR` 2
|
|
160
|
160
|
tag = 0x3 .&. n
|
|
161
|
161
|
getRep tycon =
|