never executed always true always false
1 {-
2 (c) The AQUA Project, Glasgow University, 1994-1998
3
4
5 Wired-in knowledge about primitive types
6 -}
7
8 {-# LANGUAGE CPP #-}
9 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
10
11 -- | This module defines TyCons that can't be expressed in Haskell.
12 -- They are all, therefore, wired-in TyCons. C.f module "GHC.Builtin.Types"
13 module GHC.Builtin.Types.Prim(
14 mkPrimTyConName, -- For implicit parameters in GHC.Builtin.Types only
15
16 mkTemplateKindVar, mkTemplateKindVars,
17 mkTemplateTyVars, mkTemplateTyVarsFrom,
18 mkTemplateKiTyVars, mkTemplateKiTyVar,
19
20 mkTemplateTyConBinders, mkTemplateKindTyConBinders,
21 mkTemplateAnonTyConBinders,
22
23 alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
24 alphaTyVarSpec, betaTyVarSpec, gammaTyVarSpec, deltaTyVarSpec,
25 alphaTys, alphaTy, betaTy, gammaTy, deltaTy,
26 alphaTyVarsUnliftedRep, alphaTyVarUnliftedRep,
27 alphaTysUnliftedRep, alphaTyUnliftedRep,
28 runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep3TyVar,
29 runtimeRep1TyVarInf, runtimeRep2TyVarInf,
30 runtimeRep1Ty, runtimeRep2Ty, runtimeRep3Ty,
31 levity1TyVar, levity2TyVar,
32 levity1TyVarInf, levity2TyVarInf,
33 levity1Ty, levity2Ty,
34
35 openAlphaTyVar, openBetaTyVar, openGammaTyVar,
36 openAlphaTyVarSpec, openBetaTyVarSpec, openGammaTyVarSpec,
37 openAlphaTy, openBetaTy, openGammaTy,
38
39 levPolyAlphaTyVar, levPolyBetaTyVar,
40 levPolyAlphaTyVarSpec, levPolyBetaTyVarSpec,
41 levPolyAlphaTy, levPolyBetaTy,
42
43 multiplicityTyVar1, multiplicityTyVar2,
44
45 -- Kind constructors...
46 tYPETyCon, tYPETyConName,
47
48 -- Kinds
49 tYPE, primRepToRuntimeRep, primRepsToRuntimeRep,
50
51 functionWithMultiplicity,
52 funTyCon, funTyConName,
53 unexposedPrimTyCons, exposedPrimTyCons, primTyCons,
54
55 charPrimTyCon, charPrimTy, charPrimTyConName,
56 intPrimTyCon, intPrimTy, intPrimTyConName,
57 wordPrimTyCon, wordPrimTy, wordPrimTyConName,
58 addrPrimTyCon, addrPrimTy, addrPrimTyConName,
59 floatPrimTyCon, floatPrimTy, floatPrimTyConName,
60 doublePrimTyCon, doublePrimTy, doublePrimTyConName,
61
62 statePrimTyCon, mkStatePrimTy,
63 realWorldTyCon, realWorldTy, realWorldStatePrimTy,
64
65 proxyPrimTyCon, mkProxyPrimTy,
66
67 arrayPrimTyCon, mkArrayPrimTy,
68 byteArrayPrimTyCon, byteArrayPrimTy,
69 arrayArrayPrimTyCon, mkArrayArrayPrimTy,
70 smallArrayPrimTyCon, mkSmallArrayPrimTy,
71 mutableArrayPrimTyCon, mkMutableArrayPrimTy,
72 mutableByteArrayPrimTyCon, mkMutableByteArrayPrimTy,
73 mutableArrayArrayPrimTyCon, mkMutableArrayArrayPrimTy,
74 smallMutableArrayPrimTyCon, mkSmallMutableArrayPrimTy,
75 mutVarPrimTyCon, mkMutVarPrimTy,
76
77 mVarPrimTyCon, mkMVarPrimTy,
78 ioPortPrimTyCon, mkIOPortPrimTy,
79 tVarPrimTyCon, mkTVarPrimTy,
80 stablePtrPrimTyCon, mkStablePtrPrimTy,
81 stableNamePrimTyCon, mkStableNamePrimTy,
82 compactPrimTyCon, compactPrimTy,
83 bcoPrimTyCon, bcoPrimTy,
84 weakPrimTyCon, mkWeakPrimTy,
85 threadIdPrimTyCon, threadIdPrimTy,
86 stackSnapshotPrimTyCon, stackSnapshotPrimTy,
87
88 int8PrimTyCon, int8PrimTy, int8PrimTyConName,
89 word8PrimTyCon, word8PrimTy, word8PrimTyConName,
90
91 int16PrimTyCon, int16PrimTy, int16PrimTyConName,
92 word16PrimTyCon, word16PrimTy, word16PrimTyConName,
93
94 int32PrimTyCon, int32PrimTy, int32PrimTyConName,
95 word32PrimTyCon, word32PrimTy, word32PrimTyConName,
96
97 int64PrimTyCon, int64PrimTy, int64PrimTyConName,
98 word64PrimTyCon, word64PrimTy, word64PrimTyConName,
99
100 eqPrimTyCon, -- ty1 ~# ty2
101 eqReprPrimTyCon, -- ty1 ~R# ty2 (at role Representational)
102 eqPhantPrimTyCon, -- ty1 ~P# ty2 (at role Phantom)
103 equalityTyCon,
104
105 concretePrimTyCon,
106
107 -- * SIMD
108 #include "primop-vector-tys-exports.hs-incl"
109 ) where
110
111 import GHC.Prelude
112
113 import {-# SOURCE #-} GHC.Builtin.Types
114 ( runtimeRepTy, levityTy, unboxedTupleKind, liftedTypeKind
115 , boxedRepDataConTyCon, vecRepDataConTyCon, tupleRepDataConTyCon
116 , liftedRepTy, unliftedRepTy
117 , intRepDataConTy
118 , int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy
119 , wordRepDataConTy
120 , word16RepDataConTy, word8RepDataConTy, word32RepDataConTy, word64RepDataConTy
121 , addrRepDataConTy
122 , floatRepDataConTy, doubleRepDataConTy
123 , vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy
124 , vec64DataConTy
125 , int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy
126 , int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy
127 , word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy
128 , doubleElemRepDataConTy
129 , mkPromotedListTy, multiplicityTy )
130
131 import GHC.Types.Var ( TyVarBinder, TyVar
132 , mkTyVar, mkTyVarBinder, mkTyVarBinders )
133 import GHC.Types.Name
134 import {-# SOURCE #-} GHC.Types.TyThing
135 import GHC.Core.TyCon
136 import GHC.Types.SrcLoc
137 import GHC.Types.Unique
138 import GHC.Builtin.Uniques
139 import GHC.Builtin.Names
140 import GHC.Data.FastString
141 import GHC.Utils.Outputable
142 import GHC.Utils.Panic
143 import GHC.Core.TyCo.Rep -- Doesn't need special access, but this is easier to avoid
144 -- import loops which show up if you import Type instead
145 import {-# SOURCE #-} GHC.Core.Type ( mkTyConTy, mkTyConApp, tYPE )
146
147 import Data.Char
148
149 {-
150 ************************************************************************
151 * *
152 \subsection{Primitive type constructors}
153 * *
154 ************************************************************************
155 -}
156
157 primTyCons :: [TyCon]
158 primTyCons = unexposedPrimTyCons ++ exposedPrimTyCons
159
160 -- | Primitive 'TyCon's that are defined in GHC.Prim but not exposed.
161 -- It's important to keep these separate as we don't want users to be able to
162 -- write them (see #15209) or see them in GHCi's @:browse@ output
163 -- (see #12023).
164 unexposedPrimTyCons :: [TyCon]
165 unexposedPrimTyCons
166 = [ eqPrimTyCon
167 , eqReprPrimTyCon
168 , eqPhantPrimTyCon
169 , concretePrimTyCon
170 ]
171
172 -- | Primitive 'TyCon's that are defined in, and exported from, GHC.Prim.
173 exposedPrimTyCons :: [TyCon]
174 exposedPrimTyCons
175 = [ addrPrimTyCon
176 , arrayPrimTyCon
177 , byteArrayPrimTyCon
178 , arrayArrayPrimTyCon
179 , smallArrayPrimTyCon
180 , charPrimTyCon
181 , doublePrimTyCon
182 , floatPrimTyCon
183 , intPrimTyCon
184 , int8PrimTyCon
185 , int16PrimTyCon
186 , int32PrimTyCon
187 , int64PrimTyCon
188 , bcoPrimTyCon
189 , weakPrimTyCon
190 , mutableArrayPrimTyCon
191 , mutableByteArrayPrimTyCon
192 , mutableArrayArrayPrimTyCon
193 , smallMutableArrayPrimTyCon
194 , mVarPrimTyCon
195 , ioPortPrimTyCon
196 , tVarPrimTyCon
197 , mutVarPrimTyCon
198 , realWorldTyCon
199 , stablePtrPrimTyCon
200 , stableNamePrimTyCon
201 , compactPrimTyCon
202 , statePrimTyCon
203 , proxyPrimTyCon
204 , threadIdPrimTyCon
205 , wordPrimTyCon
206 , word8PrimTyCon
207 , word16PrimTyCon
208 , word32PrimTyCon
209 , word64PrimTyCon
210 , stackSnapshotPrimTyCon
211
212 , tYPETyCon
213 , funTyCon
214
215 #include "primop-vector-tycons.hs-incl"
216 ]
217
218 mkPrimTc :: FastString -> Unique -> TyCon -> Name
219 mkPrimTc fs unique tycon
220 = mkWiredInName gHC_PRIM (mkTcOccFS fs)
221 unique
222 (mkATyCon tycon) -- Relevant TyCon
223 UserSyntax
224
225 mkBuiltInPrimTc :: FastString -> Unique -> TyCon -> Name
226 mkBuiltInPrimTc fs unique tycon
227 = mkWiredInName gHC_PRIM (mkTcOccFS fs)
228 unique
229 (mkATyCon tycon) -- Relevant TyCon
230 BuiltInSyntax
231
232
233 charPrimTyConName, intPrimTyConName, int8PrimTyConName, int16PrimTyConName, int32PrimTyConName, int64PrimTyConName,
234 wordPrimTyConName, word32PrimTyConName, word8PrimTyConName, word16PrimTyConName, word64PrimTyConName,
235 addrPrimTyConName, floatPrimTyConName, doublePrimTyConName,
236 statePrimTyConName, proxyPrimTyConName, realWorldTyConName,
237 arrayPrimTyConName, arrayArrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName,
238 mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName,
239 smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName,
240 ioPortPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName,
241 stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName,
242 weakPrimTyConName, threadIdPrimTyConName,
243 eqPrimTyConName, eqReprPrimTyConName, eqPhantPrimTyConName,
244 stackSnapshotPrimTyConName,
245 concretePrimTyConName :: Name
246 charPrimTyConName = mkPrimTc (fsLit "Char#") charPrimTyConKey charPrimTyCon
247 intPrimTyConName = mkPrimTc (fsLit "Int#") intPrimTyConKey intPrimTyCon
248 int8PrimTyConName = mkPrimTc (fsLit "Int8#") int8PrimTyConKey int8PrimTyCon
249 int16PrimTyConName = mkPrimTc (fsLit "Int16#") int16PrimTyConKey int16PrimTyCon
250 int32PrimTyConName = mkPrimTc (fsLit "Int32#") int32PrimTyConKey int32PrimTyCon
251 int64PrimTyConName = mkPrimTc (fsLit "Int64#") int64PrimTyConKey int64PrimTyCon
252 wordPrimTyConName = mkPrimTc (fsLit "Word#") wordPrimTyConKey wordPrimTyCon
253 word8PrimTyConName = mkPrimTc (fsLit "Word8#") word8PrimTyConKey word8PrimTyCon
254 word16PrimTyConName = mkPrimTc (fsLit "Word16#") word16PrimTyConKey word16PrimTyCon
255 word32PrimTyConName = mkPrimTc (fsLit "Word32#") word32PrimTyConKey word32PrimTyCon
256 word64PrimTyConName = mkPrimTc (fsLit "Word64#") word64PrimTyConKey word64PrimTyCon
257 addrPrimTyConName = mkPrimTc (fsLit "Addr#") addrPrimTyConKey addrPrimTyCon
258 floatPrimTyConName = mkPrimTc (fsLit "Float#") floatPrimTyConKey floatPrimTyCon
259 doublePrimTyConName = mkPrimTc (fsLit "Double#") doublePrimTyConKey doublePrimTyCon
260 statePrimTyConName = mkPrimTc (fsLit "State#") statePrimTyConKey statePrimTyCon
261 proxyPrimTyConName = mkPrimTc (fsLit "Proxy#") proxyPrimTyConKey proxyPrimTyCon
262 eqPrimTyConName = mkPrimTc (fsLit "~#") eqPrimTyConKey eqPrimTyCon
263 eqReprPrimTyConName = mkBuiltInPrimTc (fsLit "~R#") eqReprPrimTyConKey eqReprPrimTyCon
264 eqPhantPrimTyConName = mkBuiltInPrimTc (fsLit "~P#") eqPhantPrimTyConKey eqPhantPrimTyCon
265 realWorldTyConName = mkPrimTc (fsLit "RealWorld") realWorldTyConKey realWorldTyCon
266 arrayPrimTyConName = mkPrimTc (fsLit "Array#") arrayPrimTyConKey arrayPrimTyCon
267 byteArrayPrimTyConName = mkPrimTc (fsLit "ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon
268 arrayArrayPrimTyConName = mkPrimTc (fsLit "ArrayArray#") arrayArrayPrimTyConKey arrayArrayPrimTyCon
269 smallArrayPrimTyConName = mkPrimTc (fsLit "SmallArray#") smallArrayPrimTyConKey smallArrayPrimTyCon
270 mutableArrayPrimTyConName = mkPrimTc (fsLit "MutableArray#") mutableArrayPrimTyConKey mutableArrayPrimTyCon
271 mutableByteArrayPrimTyConName = mkPrimTc (fsLit "MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon
272 mutableArrayArrayPrimTyConName= mkPrimTc (fsLit "MutableArrayArray#") mutableArrayArrayPrimTyConKey mutableArrayArrayPrimTyCon
273 smallMutableArrayPrimTyConName= mkPrimTc (fsLit "SmallMutableArray#") smallMutableArrayPrimTyConKey smallMutableArrayPrimTyCon
274 mutVarPrimTyConName = mkPrimTc (fsLit "MutVar#") mutVarPrimTyConKey mutVarPrimTyCon
275 ioPortPrimTyConName = mkPrimTc (fsLit "IOPort#") ioPortPrimTyConKey ioPortPrimTyCon
276 mVarPrimTyConName = mkPrimTc (fsLit "MVar#") mVarPrimTyConKey mVarPrimTyCon
277 tVarPrimTyConName = mkPrimTc (fsLit "TVar#") tVarPrimTyConKey tVarPrimTyCon
278 stablePtrPrimTyConName = mkPrimTc (fsLit "StablePtr#") stablePtrPrimTyConKey stablePtrPrimTyCon
279 stableNamePrimTyConName = mkPrimTc (fsLit "StableName#") stableNamePrimTyConKey stableNamePrimTyCon
280 compactPrimTyConName = mkPrimTc (fsLit "Compact#") compactPrimTyConKey compactPrimTyCon
281 stackSnapshotPrimTyConName = mkPrimTc (fsLit "StackSnapshot#") stackSnapshotPrimTyConKey stackSnapshotPrimTyCon
282 bcoPrimTyConName = mkPrimTc (fsLit "BCO") bcoPrimTyConKey bcoPrimTyCon
283 weakPrimTyConName = mkPrimTc (fsLit "Weak#") weakPrimTyConKey weakPrimTyCon
284 threadIdPrimTyConName = mkPrimTc (fsLit "ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon
285 concretePrimTyConName = mkPrimTc (fsLit "Concrete#") concretePrimTyConKey concretePrimTyCon
286
287 {-
288 ************************************************************************
289 * *
290 \subsection{Support code}
291 * *
292 ************************************************************************
293
294 alphaTyVars is a list of type variables for use in templates:
295 ["a", "b", ..., "z", "t1", "t2", ... ]
296 -}
297
298 mkTemplateKindVar :: Kind -> TyVar
299 mkTemplateKindVar = mkTyVar (mk_tv_name 0 "k")
300
301 mkTemplateKindVars :: [Kind] -> [TyVar]
302 -- k0 with unique (mkAlphaTyVarUnique 0)
303 -- k1 with unique (mkAlphaTyVarUnique 1)
304 -- ... etc
305 mkTemplateKindVars [kind] = [mkTemplateKindVar kind]
306 -- Special case for one kind: just "k"
307 mkTemplateKindVars kinds
308 = [ mkTyVar (mk_tv_name u ('k' : show u)) kind
309 | (kind, u) <- kinds `zip` [0..] ]
310 mk_tv_name :: Int -> String -> Name
311 mk_tv_name u s = mkInternalName (mkAlphaTyVarUnique u)
312 (mkTyVarOccFS (mkFastString s))
313 noSrcSpan
314
315 mkTemplateTyVarsFrom :: Int -> [Kind] -> [TyVar]
316 -- a with unique (mkAlphaTyVarUnique n)
317 -- b with unique (mkAlphaTyVarUnique n+1)
318 -- ... etc
319 -- Typically called as
320 -- mkTemplateTyVarsFrom (length kv_bndrs) kinds
321 -- where kv_bndrs are the kind-level binders of a TyCon
322 mkTemplateTyVarsFrom n kinds
323 = [ mkTyVar name kind
324 | (kind, index) <- zip kinds [0..],
325 let ch_ord = index + ord 'a'
326 name_str | ch_ord <= ord 'z' = [chr ch_ord]
327 | otherwise = 't':show index
328 name = mk_tv_name (index + n) name_str
329 ]
330
331 mkTemplateTyVars :: [Kind] -> [TyVar]
332 mkTemplateTyVars = mkTemplateTyVarsFrom 1
333
334 mkTemplateTyConBinders
335 :: [Kind] -- [k1, .., kn] Kinds of kind-forall'd vars
336 -> ([Kind] -> [Kind]) -- Arg is [kv1:k1, ..., kvn:kn]
337 -- same length as first arg
338 -- Result is anon arg kinds
339 -> [TyConBinder]
340 mkTemplateTyConBinders kind_var_kinds mk_anon_arg_kinds
341 = kv_bndrs ++ tv_bndrs
342 where
343 kv_bndrs = mkTemplateKindTyConBinders kind_var_kinds
344 anon_kinds = mk_anon_arg_kinds (mkTyVarTys (binderVars kv_bndrs))
345 tv_bndrs = mkTemplateAnonTyConBindersFrom (length kv_bndrs) anon_kinds
346
347 mkTemplateKiTyVars
348 :: [Kind] -- [k1, .., kn] Kinds of kind-forall'd vars
349 -> ([Kind] -> [Kind]) -- Arg is [kv1:k1, ..., kvn:kn]
350 -- same length as first arg
351 -- Result is anon arg kinds [ak1, .., akm]
352 -> [TyVar] -- [kv1:k1, ..., kvn:kn, av1:ak1, ..., avm:akm]
353 -- Example: if you want the tyvars for
354 -- forall (r:RuntimeRep) (a:TYPE r) (b:*). blah
355 -- call mkTemplateKiTyVars [RuntimeRep] (\[r] -> [TYPE r, *])
356 mkTemplateKiTyVars kind_var_kinds mk_arg_kinds
357 = kv_bndrs ++ tv_bndrs
358 where
359 kv_bndrs = mkTemplateKindVars kind_var_kinds
360 anon_kinds = mk_arg_kinds (mkTyVarTys kv_bndrs)
361 tv_bndrs = mkTemplateTyVarsFrom (length kv_bndrs) anon_kinds
362
363 mkTemplateKiTyVar
364 :: Kind -- [k1, .., kn] Kind of kind-forall'd var
365 -> (Kind -> [Kind]) -- Arg is kv1:k1
366 -- Result is anon arg kinds [ak1, .., akm]
367 -> [TyVar] -- [kv1:k1, ..., kvn:kn, av1:ak1, ..., avm:akm]
368 -- Example: if you want the tyvars for
369 -- forall (r:RuntimeRep) (a:TYPE r) (b:*). blah
370 -- call mkTemplateKiTyVar RuntimeRep (\r -> [TYPE r, *])
371 mkTemplateKiTyVar kind mk_arg_kinds
372 = kv_bndr : tv_bndrs
373 where
374 kv_bndr = mkTemplateKindVar kind
375 anon_kinds = mk_arg_kinds (mkTyVarTy kv_bndr)
376 tv_bndrs = mkTemplateTyVarsFrom 1 anon_kinds
377
378 mkTemplateKindTyConBinders :: [Kind] -> [TyConBinder]
379 -- Makes named, Specified binders
380 mkTemplateKindTyConBinders kinds = [mkNamedTyConBinder Specified tv | tv <- mkTemplateKindVars kinds]
381
382 mkTemplateAnonTyConBinders :: [Kind] -> [TyConBinder]
383 mkTemplateAnonTyConBinders kinds = mkAnonTyConBinders VisArg (mkTemplateTyVars kinds)
384
385 mkTemplateAnonTyConBindersFrom :: Int -> [Kind] -> [TyConBinder]
386 mkTemplateAnonTyConBindersFrom n kinds = mkAnonTyConBinders VisArg (mkTemplateTyVarsFrom n kinds)
387
388 alphaTyVars :: [TyVar]
389 alphaTyVars = mkTemplateTyVars $ repeat liftedTypeKind
390
391 alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar :: TyVar
392 (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
393
394 alphaTyVarSpec, betaTyVarSpec, gammaTyVarSpec, deltaTyVarSpec :: TyVarBinder
395 (alphaTyVarSpec:betaTyVarSpec:gammaTyVarSpec:deltaTyVarSpec:_) = mkTyVarBinders Specified alphaTyVars
396
397 alphaTys :: [Type]
398 alphaTys = mkTyVarTys alphaTyVars
399 alphaTy, betaTy, gammaTy, deltaTy :: Type
400 (alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys
401
402 alphaTyVarsUnliftedRep :: [TyVar]
403 alphaTyVarsUnliftedRep = mkTemplateTyVars $ repeat (tYPE unliftedRepTy)
404
405 alphaTyVarUnliftedRep :: TyVar
406 (alphaTyVarUnliftedRep:_) = alphaTyVarsUnliftedRep
407
408 alphaTysUnliftedRep :: [Type]
409 alphaTysUnliftedRep = mkTyVarTys alphaTyVarsUnliftedRep
410 alphaTyUnliftedRep :: Type
411 (alphaTyUnliftedRep:_) = alphaTysUnliftedRep
412
413 runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep3TyVar :: TyVar
414 (runtimeRep1TyVar : runtimeRep2TyVar : runtimeRep3TyVar : _)
415 = drop 16 (mkTemplateTyVars (repeat runtimeRepTy)) -- selects 'q','r'
416
417 runtimeRep1TyVarInf, runtimeRep2TyVarInf :: TyVarBinder
418 runtimeRep1TyVarInf = mkTyVarBinder Inferred runtimeRep1TyVar
419 runtimeRep2TyVarInf = mkTyVarBinder Inferred runtimeRep2TyVar
420
421 runtimeRep1Ty, runtimeRep2Ty, runtimeRep3Ty :: Type
422 runtimeRep1Ty = mkTyVarTy runtimeRep1TyVar
423 runtimeRep2Ty = mkTyVarTy runtimeRep2TyVar
424 runtimeRep3Ty = mkTyVarTy runtimeRep3TyVar
425 openAlphaTyVar, openBetaTyVar, openGammaTyVar :: TyVar
426 -- alpha :: TYPE r1
427 -- beta :: TYPE r2
428 -- gamma :: TYPE r3
429 [openAlphaTyVar,openBetaTyVar,openGammaTyVar]
430 = mkTemplateTyVars [tYPE runtimeRep1Ty, tYPE runtimeRep2Ty, tYPE runtimeRep3Ty]
431
432 openAlphaTyVarSpec, openBetaTyVarSpec, openGammaTyVarSpec :: TyVarBinder
433 openAlphaTyVarSpec = mkTyVarBinder Specified openAlphaTyVar
434 openBetaTyVarSpec = mkTyVarBinder Specified openBetaTyVar
435 openGammaTyVarSpec = mkTyVarBinder Specified openGammaTyVar
436
437 openAlphaTy, openBetaTy, openGammaTy :: Type
438 openAlphaTy = mkTyVarTy openAlphaTyVar
439 openBetaTy = mkTyVarTy openBetaTyVar
440 openGammaTy = mkTyVarTy openGammaTyVar
441
442 levity1TyVar, levity2TyVar :: TyVar
443 (levity2TyVar : levity1TyVar : _) -- NB: levity2TyVar before levity1TyVar
444 = drop 10 (mkTemplateTyVars (repeat levityTy)) -- selects 'k', 'l'
445 -- The ordering of levity2TyVar before levity1TyVar is chosen so that
446 -- the more common levity1TyVar uses the levity variable 'l'.
447
448 levity1TyVarInf, levity2TyVarInf :: TyVarBinder
449 levity1TyVarInf = mkTyVarBinder Inferred levity1TyVar
450 levity2TyVarInf = mkTyVarBinder Inferred levity2TyVar
451
452 levity1Ty, levity2Ty :: Type
453 levity1Ty = mkTyVarTy levity1TyVar
454 levity2Ty = mkTyVarTy levity2TyVar
455
456 levPolyAlphaTyVar, levPolyBetaTyVar :: TyVar
457 [levPolyAlphaTyVar, levPolyBetaTyVar] =
458 mkTemplateTyVars
459 [tYPE (mkTyConApp boxedRepDataConTyCon [levity1Ty])
460 ,tYPE (mkTyConApp boxedRepDataConTyCon [levity2Ty])]
461 -- alpha :: TYPE ('BoxedRep l)
462 -- beta :: TYPE ('BoxedRep k)
463
464 levPolyAlphaTyVarSpec, levPolyBetaTyVarSpec :: TyVarBinder
465 levPolyAlphaTyVarSpec = mkTyVarBinder Specified levPolyAlphaTyVar
466 levPolyBetaTyVarSpec = mkTyVarBinder Specified levPolyBetaTyVar
467
468 levPolyAlphaTy, levPolyBetaTy :: Type
469 levPolyAlphaTy = mkTyVarTy levPolyAlphaTyVar
470 levPolyBetaTy = mkTyVarTy levPolyBetaTyVar
471
472 multiplicityTyVar1, multiplicityTyVar2 :: TyVar
473 (multiplicityTyVar1 : multiplicityTyVar2 : _)
474 = drop 13 (mkTemplateTyVars (repeat multiplicityTy)) -- selects 'n', 'm'
475
476
477 {-
478 ************************************************************************
479 * *
480 FunTyCon
481 * *
482 ************************************************************************
483 -}
484
485 funTyConName :: Name
486 funTyConName = mkPrimTyConName (fsLit "FUN") funTyConKey funTyCon
487
488 -- | The @FUN@ type constructor.
489 --
490 -- @
491 -- FUN :: forall (m :: Multiplicity) ->
492 -- forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}.
493 -- TYPE rep1 -> TYPE rep2 -> *
494 -- @
495 --
496 -- The runtime representations quantification is left inferred. This
497 -- means they cannot be specified with @-XTypeApplications@.
498 --
499 -- This is a deliberate choice to allow future extensions to the
500 -- function arrow. To allow visible application a type synonym can be
501 -- defined:
502 --
503 -- @
504 -- type Arr :: forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep).
505 -- TYPE rep1 -> TYPE rep2 -> Type
506 -- type Arr = FUN 'Many
507 -- @
508 --
509 funTyCon :: TyCon
510 funTyCon = mkFunTyCon funTyConName tc_bndrs tc_rep_nm
511 where
512 -- See also unrestrictedFunTyCon
513 tc_bndrs = [ mkNamedTyConBinder Required multiplicityTyVar1
514 , mkNamedTyConBinder Inferred runtimeRep1TyVar
515 , mkNamedTyConBinder Inferred runtimeRep2TyVar ]
516 ++ mkTemplateAnonTyConBinders [ tYPE runtimeRep1Ty
517 , tYPE runtimeRep2Ty
518 ]
519 tc_rep_nm = mkPrelTyConRepName funTyConName
520
521 {-
522 ************************************************************************
523 * *
524 Kinds
525 * *
526 ************************************************************************
527
528 Note [TYPE and RuntimeRep]
529 ~~~~~~~~~~~~~~~~~~~~~~~~~~
530 All types that classify values have a kind of the form (TYPE rr), where
531
532 data RuntimeRep -- Defined in ghc-prim:GHC.Types
533 = BoxedRep Levity
534 | IntRep
535 | FloatRep
536 .. etc ..
537
538 data Levity = Lifted | Unlifted
539
540 rr :: RuntimeRep
541
542 TYPE :: RuntimeRep -> TYPE 'LiftedRep -- Built in
543
544 So for example:
545 Int :: TYPE ('BoxedRep 'Lifted)
546 Array# Int :: TYPE ('BoxedRep 'Unlifted)
547 Int# :: TYPE 'IntRep
548 Float# :: TYPE 'FloatRep
549 Maybe :: TYPE ('BoxedRep 'Lifted) -> TYPE ('BoxedRep 'Lifted)
550 (# , #) :: TYPE r1 -> TYPE r2 -> TYPE (TupleRep [r1, r2])
551
552 We abbreviate '*' specially:
553 type LiftedRep = 'BoxedRep 'Lifted
554 type * = TYPE LiftedRep
555
556 The 'rr' parameter tells us how the value is represented at runtime.
557
558 Generally speaking, you can't be polymorphic in 'rr'. E.g
559 f :: forall (rr:RuntimeRep) (a:TYPE rr). a -> [a]
560 f = /\(rr:RuntimeRep) (a:rr) \(a:rr). ...
561 This is no good: we could not generate code for 'f', because the
562 calling convention for 'f' varies depending on whether the argument is
563 a a Int, Int#, or Float#. (You could imagine generating specialised
564 code, one for each instantiation of 'rr', but we don't do that.)
565
566 Certain functions CAN be runtime-rep-polymorphic, because the code
567 generator never has to manipulate a value of type 'a :: TYPE rr'.
568
569 * error :: forall (rr:RuntimeRep) (a:TYPE rr). String -> a
570 Code generator never has to manipulate the return value.
571
572 * unsafeCoerce#, defined in Desugar.mkUnsafeCoercePair:
573 Always inlined to be a no-op
574 unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
575 (a :: TYPE r1) (b :: TYPE r2).
576 a -> b
577
578 * Unboxed tuples, and unboxed sums, defined in GHC.Builtin.Types
579 Always inlined, and hence specialised to the call site
580 (#,#) :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
581 (a :: TYPE r1) (b :: TYPE r2).
582 a -> b -> TYPE ('TupleRep '[r1, r2])
583
584 Note [PrimRep and kindPrimRep]
585 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
586 As part of its source code, in GHC.Core.TyCon, GHC has
587 data PrimRep = BoxedRep Levity | IntRep | FloatRep | ...etc...
588
589 Notice that
590 * RuntimeRep is part of the syntax tree of the program being compiled
591 (defined in a library: ghc-prim:GHC.Types)
592 * PrimRep is part of GHC's source code.
593 (defined in GHC.Core.TyCon)
594
595 We need to get from one to the other; that is what kindPrimRep does.
596 Suppose we have a value
597 (v :: t) where (t :: k)
598 Given this kind
599 k = TyConApp "TYPE" [rep]
600 GHC needs to be able to figure out how 'v' is represented at runtime.
601 It expects 'rep' to be form
602 TyConApp rr_dc args
603 where 'rr_dc' is a promoteed data constructor from RuntimeRep. So
604 now we need to go from 'dc' to the corresponding PrimRep. We store this
605 PrimRep in the promoted data constructor itself: see TyCon.promDcRepInfo.
606
607 -}
608
609 tYPETyCon :: TyCon
610 tYPETyConName :: Name
611
612 tYPETyCon = mkKindTyCon tYPETyConName
613 (mkTemplateAnonTyConBinders [runtimeRepTy])
614 liftedTypeKind
615 [Nominal]
616 (mkPrelTyConRepName tYPETyConName)
617
618 --------------------------
619 -- ... and now their names
620
621 -- If you edit these, you may need to update the GHC formalism
622 -- See Note [GHC Formalism] in GHC.Core.Lint
623 tYPETyConName = mkPrimTyConName (fsLit "TYPE") tYPETyConKey tYPETyCon
624
625 mkPrimTyConName :: FastString -> Unique -> TyCon -> Name
626 mkPrimTyConName = mkPrimTcName BuiltInSyntax
627 -- All of the super kinds and kinds are defined in Prim,
628 -- and use BuiltInSyntax, because they are never in scope in the source
629
630 mkPrimTcName :: BuiltInSyntax -> FastString -> Unique -> TyCon -> Name
631 mkPrimTcName built_in_syntax occ key tycon
632 = mkWiredInName gHC_PRIM (mkTcOccFS occ) key (mkATyCon tycon) built_in_syntax
633
634 -----------------------------
635
636 -- Given a Multiplicity, applies FUN to it.
637 functionWithMultiplicity :: Type -> Type
638 functionWithMultiplicity mul = TyConApp funTyCon [mul]
639
640 {-
641 ************************************************************************
642 * *
643 Basic primitive types (@Char#@, @Int#@, etc.)
644 * *
645 ************************************************************************
646 -}
647
648 -- only used herein
649 pcPrimTyCon :: Name -> [Role] -> PrimRep -> TyCon
650 pcPrimTyCon name roles rep
651 = mkPrimTyCon name binders result_kind roles
652 where
653 binders = mkTemplateAnonTyConBinders (map (const liftedTypeKind) roles)
654 result_kind = tYPE (primRepToRuntimeRep rep)
655
656 -- | Convert a 'PrimRep' to a 'Type' of kind RuntimeRep
657 -- Defined here to avoid (more) module loops
658 primRepToRuntimeRep :: PrimRep -> Type
659 primRepToRuntimeRep rep = case rep of
660 VoidRep -> mkTupleRep []
661 LiftedRep -> liftedRepTy
662 UnliftedRep -> unliftedRepTy
663 IntRep -> intRepDataConTy
664 Int8Rep -> int8RepDataConTy
665 Int16Rep -> int16RepDataConTy
666 Int32Rep -> int32RepDataConTy
667 Int64Rep -> int64RepDataConTy
668 WordRep -> wordRepDataConTy
669 Word8Rep -> word8RepDataConTy
670 Word16Rep -> word16RepDataConTy
671 Word32Rep -> word32RepDataConTy
672 Word64Rep -> word64RepDataConTy
673 AddrRep -> addrRepDataConTy
674 FloatRep -> floatRepDataConTy
675 DoubleRep -> doubleRepDataConTy
676 VecRep n elem -> TyConApp vecRepDataConTyCon [n', elem']
677 where
678 n' = case n of
679 2 -> vec2DataConTy
680 4 -> vec4DataConTy
681 8 -> vec8DataConTy
682 16 -> vec16DataConTy
683 32 -> vec32DataConTy
684 64 -> vec64DataConTy
685 _ -> pprPanic "Disallowed VecCount" (ppr n)
686
687 elem' = case elem of
688 Int8ElemRep -> int8ElemRepDataConTy
689 Int16ElemRep -> int16ElemRepDataConTy
690 Int32ElemRep -> int32ElemRepDataConTy
691 Int64ElemRep -> int64ElemRepDataConTy
692 Word8ElemRep -> word8ElemRepDataConTy
693 Word16ElemRep -> word16ElemRepDataConTy
694 Word32ElemRep -> word32ElemRepDataConTy
695 Word64ElemRep -> word64ElemRepDataConTy
696 FloatElemRep -> floatElemRepDataConTy
697 DoubleElemRep -> doubleElemRepDataConTy
698
699 -- | Given a list of types representing 'RuntimeRep's @reps@, construct
700 -- @'TupleRep' reps@.
701 mkTupleRep :: [Type] -> Type
702 mkTupleRep reps = TyConApp tupleRepDataConTyCon [mkPromotedListTy runtimeRepTy reps]
703
704 -- | Convert a list of 'PrimRep's to a 'Type' of kind RuntimeRep
705 -- Defined here to avoid (more) module loops
706 primRepsToRuntimeRep :: [PrimRep] -> Type
707 primRepsToRuntimeRep [rep] = primRepToRuntimeRep rep
708 primRepsToRuntimeRep reps = mkTupleRep $ map primRepToRuntimeRep reps
709
710 pcPrimTyCon0 :: Name -> PrimRep -> TyCon
711 pcPrimTyCon0 name rep
712 = pcPrimTyCon name [] rep
713
714 charPrimTy :: Type
715 charPrimTy = mkTyConTy charPrimTyCon
716 charPrimTyCon :: TyCon
717 charPrimTyCon = pcPrimTyCon0 charPrimTyConName WordRep
718
719 intPrimTy :: Type
720 intPrimTy = mkTyConTy intPrimTyCon
721 intPrimTyCon :: TyCon
722 intPrimTyCon = pcPrimTyCon0 intPrimTyConName IntRep
723
724 int8PrimTy :: Type
725 int8PrimTy = mkTyConTy int8PrimTyCon
726 int8PrimTyCon :: TyCon
727 int8PrimTyCon = pcPrimTyCon0 int8PrimTyConName Int8Rep
728
729 int16PrimTy :: Type
730 int16PrimTy = mkTyConTy int16PrimTyCon
731 int16PrimTyCon :: TyCon
732 int16PrimTyCon = pcPrimTyCon0 int16PrimTyConName Int16Rep
733
734 int32PrimTy :: Type
735 int32PrimTy = mkTyConTy int32PrimTyCon
736 int32PrimTyCon :: TyCon
737 int32PrimTyCon = pcPrimTyCon0 int32PrimTyConName Int32Rep
738
739 int64PrimTy :: Type
740 int64PrimTy = mkTyConTy int64PrimTyCon
741 int64PrimTyCon :: TyCon
742 int64PrimTyCon = pcPrimTyCon0 int64PrimTyConName Int64Rep
743
744 wordPrimTy :: Type
745 wordPrimTy = mkTyConTy wordPrimTyCon
746 wordPrimTyCon :: TyCon
747 wordPrimTyCon = pcPrimTyCon0 wordPrimTyConName WordRep
748
749 word8PrimTy :: Type
750 word8PrimTy = mkTyConTy word8PrimTyCon
751 word8PrimTyCon :: TyCon
752 word8PrimTyCon = pcPrimTyCon0 word8PrimTyConName Word8Rep
753
754 word16PrimTy :: Type
755 word16PrimTy = mkTyConTy word16PrimTyCon
756 word16PrimTyCon :: TyCon
757 word16PrimTyCon = pcPrimTyCon0 word16PrimTyConName Word16Rep
758
759 word32PrimTy :: Type
760 word32PrimTy = mkTyConTy word32PrimTyCon
761 word32PrimTyCon :: TyCon
762 word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName Word32Rep
763
764 word64PrimTy :: Type
765 word64PrimTy = mkTyConTy word64PrimTyCon
766 word64PrimTyCon :: TyCon
767 word64PrimTyCon = pcPrimTyCon0 word64PrimTyConName Word64Rep
768
769 addrPrimTy :: Type
770 addrPrimTy = mkTyConTy addrPrimTyCon
771 addrPrimTyCon :: TyCon
772 addrPrimTyCon = pcPrimTyCon0 addrPrimTyConName AddrRep
773
774 floatPrimTy :: Type
775 floatPrimTy = mkTyConTy floatPrimTyCon
776 floatPrimTyCon :: TyCon
777 floatPrimTyCon = pcPrimTyCon0 floatPrimTyConName FloatRep
778
779 doublePrimTy :: Type
780 doublePrimTy = mkTyConTy doublePrimTyCon
781 doublePrimTyCon :: TyCon
782 doublePrimTyCon = pcPrimTyCon0 doublePrimTyConName DoubleRep
783
784 {-
785 ************************************************************************
786 * *
787 The @State#@ type (and @_RealWorld@ types)
788 * *
789 ************************************************************************
790
791 Note [The equality types story]
792 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
793 GHC sports a veritable menagerie of equality types:
794
795 Type or Lifted? Hetero? Role Built in Defining module
796 class? L/U TyCon
797 -----------------------------------------------------------------------------------------
798 ~# T U hetero nominal eqPrimTyCon GHC.Prim
799 ~~ C L hetero nominal heqTyCon GHC.Types
800 ~ C L homo nominal eqTyCon GHC.Types
801 :~: T L homo nominal (not built-in) Data.Type.Equality
802 :~~: T L hetero nominal (not built-in) Data.Type.Equality
803
804 ~R# T U hetero repr eqReprPrimTy GHC.Prim
805 Coercible C L homo repr coercibleTyCon GHC.Types
806 Coercion T L homo repr (not built-in) Data.Type.Coercion
807 ~P# T U hetero phantom eqPhantPrimTyCon GHC.Prim
808
809 Recall that "hetero" means the equality can related types of different
810 kinds. Knowing that (t1 ~# t2) or (t1 ~R# t2) or even that (t1 ~P# t2)
811 also means that (k1 ~# k2), where (t1 :: k1) and (t2 :: k2).
812
813 To produce less confusion for end users, when not dumping and without
814 -fprint-equality-relations, each of these groups is printed as the bottommost
815 listed equality. That is, (~#) and (~~) are both rendered as (~) in
816 error messages, and (~R#) is rendered as Coercible.
817
818 Let's take these one at a time:
819
820 --------------------------
821 (~#) :: forall k1 k2. k1 -> k2 -> TYPE (TupleRep '[])
822 --------------------------
823 This is The Type Of Equality in GHC. It classifies nominal coercions.
824 This type is used in the solver for recording equality constraints.
825 It responds "yes" to Type.isEqPrimPred and classifies as an EqPred in
826 Type.classifyPredType.
827
828 All wanted constraints of this type are built with coercion holes.
829 (See Note [Coercion holes] in GHC.Core.TyCo.Rep.) But see also
830 Note [Deferred errors for coercion holes] in GHC.Tc.Errors to see how
831 equality constraints are deferred.
832
833 Within GHC, ~# is called eqPrimTyCon, and it is defined in GHC.Builtin.Types.Prim.
834
835
836 --------------------------
837 (~~) :: forall k1 k2. k1 -> k2 -> Constraint
838 --------------------------
839 This is (almost) an ordinary class, defined as if by
840 class a ~# b => a ~~ b
841 instance a ~# b => a ~~ b
842 Here's what's unusual about it:
843
844 * We can't actually declare it that way because we don't have syntax for ~#.
845 And ~# isn't a constraint, so even if we could write it, it wouldn't kind
846 check.
847
848 * Users cannot write instances of it.
849
850 * It is "naturally coherent". This means that the solver won't hesitate to
851 solve a goal of type (a ~~ b) even if there is, say (Int ~~ c) in the
852 context. (Normally, it waits to learn more, just in case the given
853 influences what happens next.) See Note [Naturally coherent classes]
854 in GHC.Tc.Solver.Interact.
855
856 * It always terminates. That is, in the UndecidableInstances checks, we
857 don't worry if a (~~) constraint is too big, as we know that solving
858 equality terminates.
859
860 On the other hand, this behaves just like any class w.r.t. eager superclass
861 unpacking in the solver. So a lifted equality given quickly becomes an unlifted
862 equality given. This is good, because the solver knows all about unlifted
863 equalities. There is some special-casing in GHC.Tc.Solver.Interact.matchClassInst to
864 pretend that there is an instance of this class, as we can't write the instance
865 in Haskell.
866
867 Within GHC, ~~ is called heqTyCon, and it is defined in GHC.Builtin.Types.
868
869
870 --------------------------
871 (~) :: forall k. k -> k -> Constraint
872 --------------------------
873 This is /exactly/ like (~~), except with a homogeneous kind.
874 It is an almost-ordinary class defined as if by
875 class a ~# b => (a :: k) ~ (b :: k)
876 instance a ~# b => a ~ b
877
878 * All the bullets for (~~) apply
879
880 * In addition (~) is magical syntax, as ~ is a reserved symbol.
881 It cannot be exported or imported.
882
883 Within GHC, ~ is called eqTyCon, and it is defined in GHC.Builtin.Types.
884
885 Historical note: prior to July 18 (~) was defined as a
886 more-ordinary class with (~~) as a superclass. But that made it
887 special in different ways; and the extra superclass selections to
888 get from (~) to (~#) via (~~) were tiresome. Now it's defined
889 uniformly with (~~) and Coercible; much nicer.)
890
891
892 --------------------------
893 (:~:) :: forall k. k -> k -> *
894 (:~~:) :: forall k1 k2. k1 -> k2 -> *
895 --------------------------
896 These are perfectly ordinary GADTs, wrapping (~) and (~~) resp.
897 They are not defined within GHC at all.
898
899
900 --------------------------
901 (~R#) :: forall k1 k2. k1 -> k2 -> TYPE (TupleRep '[])
902 --------------------------
903 The is the representational analogue of ~#. This is the type of representational
904 equalities that the solver works on. All wanted constraints of this type are
905 built with coercion holes.
906
907 Within GHC, ~R# is called eqReprPrimTyCon, and it is defined in GHC.Builtin.Types.Prim.
908
909
910 --------------------------
911 Coercible :: forall k. k -> k -> Constraint
912 --------------------------
913 This is quite like (~~) in the way it's defined and treated within GHC, but
914 it's homogeneous. Homogeneity helps with type inference (as GHC can solve one
915 kind from the other) and, in my (Richard's) estimation, will be more intuitive
916 for users.
917
918 An alternative design included HCoercible (like (~~)) and Coercible (like (~)).
919 One annoyance was that we want `coerce :: Coercible a b => a -> b`, and
920 we need the type of coerce to be fully wired-in. So the HCoercible/Coercible
921 split required that both types be fully wired-in. Instead of doing this,
922 I just got rid of HCoercible, as I'm not sure who would use it, anyway.
923
924 Within GHC, Coercible is called coercibleTyCon, and it is defined in
925 GHC.Builtin.Types.
926
927
928 --------------------------
929 Coercion :: forall k. k -> k -> *
930 --------------------------
931 This is a perfectly ordinary GADT, wrapping Coercible. It is not defined
932 within GHC at all.
933
934
935 --------------------------
936 (~P#) :: forall k1 k2. k1 -> k2 -> TYPE (TupleRep '[])
937 --------------------------
938 This is the phantom analogue of ~# and it is barely used at all.
939 (The solver has no idea about this one.) Here is the motivation:
940
941 data Phant a = MkPhant
942 type role Phant phantom
943
944 Phant <Int, Bool>_P :: Phant Int ~P# Phant Bool
945
946 We just need to have something to put on that last line. You probably
947 don't need to worry about it.
948
949
950
951 Note [The State# TyCon]
952 ~~~~~~~~~~~~~~~~~~~~~~~
953 State# is the primitive, unlifted type of states. It has one type parameter,
954 thus
955 State# RealWorld
956 or
957 State# s
958
959 where s is a type variable. The only purpose of the type parameter is to
960 keep different state threads separate. It is represented by nothing at all.
961
962 The type parameter to State# is intended to keep separate threads separate.
963 Even though this parameter is not used in the definition of State#, it is
964 given role Nominal to enforce its intended use.
965 -}
966
967 mkStatePrimTy :: Type -> Type
968 mkStatePrimTy ty = TyConApp statePrimTyCon [ty]
969
970 statePrimTyCon :: TyCon -- See Note [The State# TyCon]
971 statePrimTyCon = pcPrimTyCon statePrimTyConName [Nominal] VoidRep
972
973 {-
974 RealWorld is deeply magical. It is *primitive*, but it is not
975 *unlifted* (hence ptrArg). We never manipulate values of type
976 RealWorld; it's only used in the type system, to parameterise State#.
977 -}
978
979 realWorldTyCon :: TyCon
980 realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName [] liftedTypeKind []
981 realWorldTy :: Type
982 realWorldTy = mkTyConTy realWorldTyCon
983 realWorldStatePrimTy :: Type
984 realWorldStatePrimTy = mkStatePrimTy realWorldTy -- State# RealWorld
985
986 -- Note: the ``state-pairing'' types are not truly primitive,
987 -- so they are defined in \tr{GHC.Builtin.Types}, not here.
988
989
990 mkProxyPrimTy :: Type -> Type -> Type
991 mkProxyPrimTy k ty = TyConApp proxyPrimTyCon [k, ty]
992
993 proxyPrimTyCon :: TyCon
994 proxyPrimTyCon = mkPrimTyCon proxyPrimTyConName binders res_kind [Nominal,Phantom]
995 where
996 -- Kind: forall k. k -> TYPE (TupleRep '[])
997 binders = mkTemplateTyConBinders [liftedTypeKind] id
998 res_kind = unboxedTupleKind []
999
1000
1001 {- *********************************************************************
1002 * *
1003 Primitive equality constraints
1004 See Note [The equality types story]
1005 * *
1006 ********************************************************************* -}
1007
1008 eqPrimTyCon :: TyCon -- The representation type for equality predicates
1009 -- See Note [The equality types story]
1010 eqPrimTyCon = mkPrimTyCon eqPrimTyConName binders res_kind roles
1011 where
1012 -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (TupleRep '[])
1013 binders = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id
1014 res_kind = unboxedTupleKind []
1015 roles = [Nominal, Nominal, Nominal, Nominal]
1016
1017 -- like eqPrimTyCon, but the type for *Representational* coercions
1018 -- this should only ever appear as the type of a covar. Its role is
1019 -- interpreted in coercionRole
1020 eqReprPrimTyCon :: TyCon -- See Note [The equality types story]
1021 eqReprPrimTyCon = mkPrimTyCon eqReprPrimTyConName binders res_kind roles
1022 where
1023 -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (TupleRep '[])
1024 binders = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id
1025 res_kind = unboxedTupleKind []
1026 roles = [Nominal, Nominal, Representational, Representational]
1027
1028 -- like eqPrimTyCon, but the type for *Phantom* coercions.
1029 -- This is only used to make higher-order equalities. Nothing
1030 -- should ever actually have this type!
1031 eqPhantPrimTyCon :: TyCon
1032 eqPhantPrimTyCon = mkPrimTyCon eqPhantPrimTyConName binders res_kind roles
1033 where
1034 -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (TupleRep '[])
1035 binders = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id
1036 res_kind = unboxedTupleKind []
1037 roles = [Nominal, Nominal, Phantom, Phantom]
1038
1039 -- | Given a Role, what TyCon is the type of equality predicates at that role?
1040 equalityTyCon :: Role -> TyCon
1041 equalityTyCon Nominal = eqPrimTyCon
1042 equalityTyCon Representational = eqReprPrimTyCon
1043 equalityTyCon Phantom = eqPhantPrimTyCon
1044
1045 {- *********************************************************************
1046 * *
1047 The Concrete mechanism
1048 * *
1049 ********************************************************************* -}
1050
1051 -- See Note [The Concrete mechanism] in GHC.Tc.Utils.Concrete.
1052
1053 -- type Concrete# :: forall k. k -> TYPE (TupleRep '[])
1054
1055 concretePrimTyCon :: TyCon
1056 concretePrimTyCon =
1057 mkPrimTyCon concretePrimTyConName binders res_kind roles
1058 where
1059 -- Kind :: forall k. k -> TYPE (TupleRep '[])
1060 binders = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k])
1061 res_kind = unboxedTupleKind []
1062 roles = [Nominal, Nominal]
1063
1064 {- *********************************************************************
1065 * *
1066 The primitive array types
1067 * *
1068 ********************************************************************* -}
1069
1070 arrayPrimTyCon, mutableArrayPrimTyCon, mutableByteArrayPrimTyCon,
1071 byteArrayPrimTyCon, arrayArrayPrimTyCon, mutableArrayArrayPrimTyCon,
1072 smallArrayPrimTyCon, smallMutableArrayPrimTyCon :: TyCon
1073 arrayPrimTyCon = pcPrimTyCon arrayPrimTyConName [Representational] UnliftedRep
1074 mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConName [Nominal, Representational] UnliftedRep
1075 mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConName [Nominal] UnliftedRep
1076 byteArrayPrimTyCon = pcPrimTyCon0 byteArrayPrimTyConName UnliftedRep
1077 arrayArrayPrimTyCon = pcPrimTyCon0 arrayArrayPrimTyConName UnliftedRep
1078 mutableArrayArrayPrimTyCon = pcPrimTyCon mutableArrayArrayPrimTyConName [Nominal] UnliftedRep
1079 smallArrayPrimTyCon = pcPrimTyCon smallArrayPrimTyConName [Representational] UnliftedRep
1080 smallMutableArrayPrimTyCon = pcPrimTyCon smallMutableArrayPrimTyConName [Nominal, Representational] UnliftedRep
1081
1082 mkArrayPrimTy :: Type -> Type
1083 mkArrayPrimTy elt = TyConApp arrayPrimTyCon [elt]
1084 byteArrayPrimTy :: Type
1085 byteArrayPrimTy = mkTyConTy byteArrayPrimTyCon
1086 mkArrayArrayPrimTy :: Type
1087 mkArrayArrayPrimTy = mkTyConTy arrayArrayPrimTyCon
1088 mkSmallArrayPrimTy :: Type -> Type
1089 mkSmallArrayPrimTy elt = TyConApp smallArrayPrimTyCon [elt]
1090 mkMutableArrayPrimTy :: Type -> Type -> Type
1091 mkMutableArrayPrimTy s elt = TyConApp mutableArrayPrimTyCon [s, elt]
1092 mkMutableByteArrayPrimTy :: Type -> Type
1093 mkMutableByteArrayPrimTy s = TyConApp mutableByteArrayPrimTyCon [s]
1094 mkMutableArrayArrayPrimTy :: Type -> Type
1095 mkMutableArrayArrayPrimTy s = TyConApp mutableArrayArrayPrimTyCon [s]
1096 mkSmallMutableArrayPrimTy :: Type -> Type -> Type
1097 mkSmallMutableArrayPrimTy s elt = TyConApp smallMutableArrayPrimTyCon [s, elt]
1098
1099
1100 {- *********************************************************************
1101 * *
1102 The mutable variable type
1103 * *
1104 ********************************************************************* -}
1105
1106 mutVarPrimTyCon :: TyCon
1107 mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName [Nominal, Representational] UnliftedRep
1108
1109 mkMutVarPrimTy :: Type -> Type -> Type
1110 mkMutVarPrimTy s elt = TyConApp mutVarPrimTyCon [s, elt]
1111
1112 {-
1113 ************************************************************************
1114 * *
1115 \subsection[TysPrim-io-port-var]{The synchronizing I/O Port type}
1116 * *
1117 ************************************************************************
1118 -}
1119
1120 ioPortPrimTyCon :: TyCon
1121 ioPortPrimTyCon = pcPrimTyCon ioPortPrimTyConName [Nominal, Representational] UnliftedRep
1122
1123 mkIOPortPrimTy :: Type -> Type -> Type
1124 mkIOPortPrimTy s elt = TyConApp ioPortPrimTyCon [s, elt]
1125
1126 {-
1127 ************************************************************************
1128 * *
1129 The synchronizing variable type
1130 \subsection[TysPrim-synch-var]{The synchronizing variable type}
1131 * *
1132 ************************************************************************
1133 -}
1134
1135 mVarPrimTyCon :: TyCon
1136 mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName [Nominal, Representational] UnliftedRep
1137
1138 mkMVarPrimTy :: Type -> Type -> Type
1139 mkMVarPrimTy s elt = TyConApp mVarPrimTyCon [s, elt]
1140
1141 {-
1142 ************************************************************************
1143 * *
1144 The transactional variable type
1145 * *
1146 ************************************************************************
1147 -}
1148
1149 tVarPrimTyCon :: TyCon
1150 tVarPrimTyCon = pcPrimTyCon tVarPrimTyConName [Nominal, Representational] UnliftedRep
1151
1152 mkTVarPrimTy :: Type -> Type -> Type
1153 mkTVarPrimTy s elt = TyConApp tVarPrimTyCon [s, elt]
1154
1155 {-
1156 ************************************************************************
1157 * *
1158 The stable-pointer type
1159 * *
1160 ************************************************************************
1161 -}
1162
1163 stablePtrPrimTyCon :: TyCon
1164 stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName [Representational] AddrRep
1165
1166 mkStablePtrPrimTy :: Type -> Type
1167 mkStablePtrPrimTy ty = TyConApp stablePtrPrimTyCon [ty]
1168
1169 {-
1170 ************************************************************************
1171 * *
1172 The stable-name type
1173 * *
1174 ************************************************************************
1175 -}
1176
1177 stableNamePrimTyCon :: TyCon
1178 stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName [Phantom] UnliftedRep
1179
1180 mkStableNamePrimTy :: Type -> Type
1181 mkStableNamePrimTy ty = TyConApp stableNamePrimTyCon [ty]
1182
1183 {-
1184 ************************************************************************
1185 * *
1186 The Compact NFData (CNF) type
1187 * *
1188 ************************************************************************
1189 -}
1190
1191 compactPrimTyCon :: TyCon
1192 compactPrimTyCon = pcPrimTyCon0 compactPrimTyConName UnliftedRep
1193
1194 compactPrimTy :: Type
1195 compactPrimTy = mkTyConTy compactPrimTyCon
1196
1197 {-
1198 ************************************************************************
1199 * *
1200 The @StackSnapshot#@ type
1201 * *
1202 ************************************************************************
1203 -}
1204
1205 stackSnapshotPrimTyCon :: TyCon
1206 stackSnapshotPrimTyCon = pcPrimTyCon0 stackSnapshotPrimTyConName UnliftedRep
1207
1208 stackSnapshotPrimTy :: Type
1209 stackSnapshotPrimTy = mkTyConTy stackSnapshotPrimTyCon
1210
1211
1212 {-
1213 ************************************************************************
1214 * *
1215 The ``bytecode object'' type
1216 * *
1217 ************************************************************************
1218 -}
1219
1220 -- Unlike most other primitive types, BCO is lifted. This is because in
1221 -- general a BCO may be a thunk for the reasons given in Note [Updatable CAF
1222 -- BCOs] in GHCi.CreateBCO.
1223 bcoPrimTy :: Type
1224 bcoPrimTy = mkTyConTy bcoPrimTyCon
1225 bcoPrimTyCon :: TyCon
1226 bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName LiftedRep
1227
1228 {-
1229 ************************************************************************
1230 * *
1231 The ``weak pointer'' type
1232 * *
1233 ************************************************************************
1234 -}
1235
1236 weakPrimTyCon :: TyCon
1237 weakPrimTyCon = pcPrimTyCon weakPrimTyConName [Representational] UnliftedRep
1238
1239 mkWeakPrimTy :: Type -> Type
1240 mkWeakPrimTy v = TyConApp weakPrimTyCon [v]
1241
1242 {-
1243 ************************************************************************
1244 * *
1245 The ``thread id'' type
1246 * *
1247 ************************************************************************
1248
1249 A thread id is represented by a pointer to the TSO itself, to ensure
1250 that they are always unique and we can always find the TSO for a given
1251 thread id. However, this has the unfortunate consequence that a
1252 ThreadId# for a given thread is treated as a root by the garbage
1253 collector and can keep TSOs around for too long.
1254
1255 Hence the programmer API for thread manipulation uses a weak pointer
1256 to the thread id internally.
1257 -}
1258
1259 threadIdPrimTy :: Type
1260 threadIdPrimTy = mkTyConTy threadIdPrimTyCon
1261 threadIdPrimTyCon :: TyCon
1262 threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName UnliftedRep
1263
1264 {-
1265 ************************************************************************
1266 * *
1267 \subsection{SIMD vector types}
1268 * *
1269 ************************************************************************
1270 -}
1271
1272 #include "primop-vector-tys.hs-incl"