Encode shape information in `PmOracle`
[ghc.git] / compiler / prelude / TysWiredIn.hs
1 {-
2 (c) The GRASP Project, Glasgow University, 1994-1998
3
4 \section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types}
5 -}
6
7 {-# LANGUAGE CPP #-}
8 {-# LANGUAGE OverloadedStrings #-}
9
10 -- | This module is about types that can be defined in Haskell, but which
11 -- must be wired into the compiler nonetheless. C.f module TysPrim
12 module TysWiredIn (
13 -- * Helper functions defined here
14 mkWiredInTyConName, -- This is used in TcTypeNats to define the
15 -- built-in functions for evaluation.
16
17 mkWiredInIdName, -- used in MkId
18
19 -- * All wired in things
20 wiredInTyCons, isBuiltInOcc_maybe,
21
22 -- * Bool
23 boolTy, boolTyCon, boolTyCon_RDR, boolTyConName,
24 trueDataCon, trueDataConId, true_RDR,
25 falseDataCon, falseDataConId, false_RDR,
26 promotedFalseDataCon, promotedTrueDataCon,
27
28 -- * Ordering
29 orderingTyCon,
30 ordLTDataCon, ordLTDataConId,
31 ordEQDataCon, ordEQDataConId,
32 ordGTDataCon, ordGTDataConId,
33 promotedLTDataCon, promotedEQDataCon, promotedGTDataCon,
34
35 -- * Boxing primitive types
36 boxingDataCon_maybe,
37
38 -- * Char
39 charTyCon, charDataCon, charTyCon_RDR,
40 charTy, stringTy, charTyConName,
41
42 -- * Double
43 doubleTyCon, doubleDataCon, doubleTy, doubleTyConName,
44
45 -- * Float
46 floatTyCon, floatDataCon, floatTy, floatTyConName,
47
48 -- * Int
49 intTyCon, intDataCon, intTyCon_RDR, intDataCon_RDR, intTyConName,
50 intTy,
51
52 -- * Word
53 wordTyCon, wordDataCon, wordTyConName, wordTy,
54
55 -- * Word8
56 word8TyCon, word8DataCon, word8TyConName, word8Ty,
57
58 -- * List
59 listTyCon, listTyCon_RDR, listTyConName, listTyConKey,
60 nilDataCon, nilDataConName, nilDataConKey,
61 consDataCon_RDR, consDataCon, consDataConName,
62 promotedNilDataCon, promotedConsDataCon,
63 mkListTy, mkPromotedListTy,
64
65 -- * Maybe
66 maybeTyCon, maybeTyConName,
67 nothingDataCon, nothingDataConName, promotedNothingDataCon,
68 justDataCon, justDataConName, promotedJustDataCon,
69
70 -- * Tuples
71 mkTupleTy, mkBoxedTupleTy,
72 tupleTyCon, tupleDataCon, tupleTyConName,
73 promotedTupleDataCon,
74 unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey,
75 pairTyCon,
76 unboxedUnitTyCon, unboxedUnitDataCon,
77 unboxedTupleKind, unboxedSumKind,
78
79 -- ** Constraint tuples
80 cTupleTyConName, cTupleTyConNames, isCTupleTyConName,
81 cTupleTyConNameArity_maybe,
82 cTupleDataConName, cTupleDataConNames,
83
84 -- * Any
85 anyTyCon, anyTy, anyTypeOfKind,
86
87 -- * Recovery TyCon
88 makeRecoveryTyCon,
89
90 -- * Sums
91 mkSumTy, sumTyCon, sumDataCon,
92
93 -- * Kinds
94 typeNatKindCon, typeNatKind, typeSymbolKindCon, typeSymbolKind,
95 isLiftedTypeKindTyConName, liftedTypeKind, constraintKind,
96 liftedTypeKindTyCon, constraintKindTyCon,
97 liftedTypeKindTyConName,
98
99 -- * Equality predicates
100 heqTyCon, heqTyConName, heqClass, heqDataCon,
101 eqTyCon, eqTyConName, eqClass, eqDataCon, eqTyCon_RDR,
102 coercibleTyCon, coercibleTyConName, coercibleDataCon, coercibleClass,
103
104 -- * RuntimeRep and friends
105 runtimeRepTyCon, vecCountTyCon, vecElemTyCon,
106
107 runtimeRepTy, liftedRepTy, liftedRepDataCon, liftedRepDataConTyCon,
108
109 vecRepDataConTyCon, tupleRepDataConTyCon, sumRepDataConTyCon,
110
111 liftedRepDataConTy, unliftedRepDataConTy,
112 intRepDataConTy,
113 int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
114 wordRepDataConTy,
115 word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,
116 addrRepDataConTy,
117 floatRepDataConTy, doubleRepDataConTy,
118
119 vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
120 vec64DataConTy,
121
122 int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
123 int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
124 word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,
125 doubleElemRepDataConTy
126
127 ) where
128
129 #include "HsVersions.h"
130 #include "MachDeps.h"
131
132 import GhcPrelude
133
134 import {-# SOURCE #-} MkId( mkDataConWorkId, mkDictSelId )
135
136 -- friends:
137 import PrelNames
138 import TysPrim
139 import {-# SOURCE #-} KnownUniques
140
141 -- others:
142 import CoAxiom
143 import Id
144 import Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE )
145 import Module ( Module )
146 import Type
147 import RepType
148 import DataCon
149 import {-# SOURCE #-} ConLike
150 import TyCon
151 import Class ( Class, mkClass )
152 import RdrName
153 import Name
154 import NameEnv ( NameEnv, mkNameEnv, lookupNameEnv, lookupNameEnv_NF )
155 import NameSet ( NameSet, mkNameSet, elemNameSet )
156 import BasicTypes ( Arity, Boxity(..), TupleSort(..), ConTagZ,
157 SourceText(..) )
158 import ForeignCall
159 import SrcLoc ( noSrcSpan )
160 import Unique
161 import Data.Array
162 import FastString
163 import Outputable
164 import Util
165 import BooleanFormula ( mkAnd )
166
167 import qualified Data.ByteString.Char8 as BS
168
169 import Data.List ( elemIndex )
170
171 alpha_tyvar :: [TyVar]
172 alpha_tyvar = [alphaTyVar]
173
174 alpha_ty :: [Type]
175 alpha_ty = [alphaTy]
176
177 {-
178 Note [Wiring in RuntimeRep]
179 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
180 The RuntimeRep type (and friends) in GHC.Types has a bunch of constructors,
181 making it a pain to wire in. To ease the pain somewhat, we use lists of
182 the different bits, like Uniques, Names, DataCons. These lists must be
183 kept in sync with each other. The rule is this: use the order as declared
184 in GHC.Types. All places where such lists exist should contain a reference
185 to this Note, so a search for this Note's name should find all the lists.
186
187 See also Note [Getting from RuntimeRep to PrimRep] in RepType.
188
189 ************************************************************************
190 * *
191 \subsection{Wired in type constructors}
192 * *
193 ************************************************************************
194
195 If you change which things are wired in, make sure you change their
196 names in PrelNames, so they use wTcQual, wDataQual, etc
197 -}
198
199 -- This list is used only to define PrelInfo.wiredInThings. That in turn
200 -- is used to initialise the name environment carried around by the renamer.
201 -- This means that if we look up the name of a TyCon (or its implicit binders)
202 -- that occurs in this list that name will be assigned the wired-in key we
203 -- define here.
204 --
205 -- Because of their infinite nature, this list excludes tuples, Any and implicit
206 -- parameter TyCons (see Note [Built-in syntax and the OrigNameCache]).
207 --
208 -- See also Note [Known-key names]
209 wiredInTyCons :: [TyCon]
210
211 wiredInTyCons = [ -- Units are not treated like other tuples, because then
212 -- are defined in GHC.Base, and there's only a few of them. We
213 -- put them in wiredInTyCons so that they will pre-populate
214 -- the name cache, so the parser in isBuiltInOcc_maybe doesn't
215 -- need to look out for them.
216 unitTyCon
217 , unboxedUnitTyCon
218 , anyTyCon
219 , boolTyCon
220 , charTyCon
221 , doubleTyCon
222 , floatTyCon
223 , intTyCon
224 , wordTyCon
225 , word8TyCon
226 , listTyCon
227 , maybeTyCon
228 , heqTyCon
229 , eqTyCon
230 , coercibleTyCon
231 , typeNatKindCon
232 , typeSymbolKindCon
233 , runtimeRepTyCon
234 , vecCountTyCon
235 , vecElemTyCon
236 , constraintKindTyCon
237 , liftedTypeKindTyCon
238 ]
239
240 mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
241 mkWiredInTyConName built_in modu fs unique tycon
242 = mkWiredInName modu (mkTcOccFS fs) unique
243 (ATyCon tycon) -- Relevant TyCon
244 built_in
245
246 mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
247 mkWiredInDataConName built_in modu fs unique datacon
248 = mkWiredInName modu (mkDataOccFS fs) unique
249 (AConLike (RealDataCon datacon)) -- Relevant DataCon
250 built_in
251
252 mkWiredInIdName :: Module -> FastString -> Unique -> Id -> Name
253 mkWiredInIdName mod fs uniq id
254 = mkWiredInName mod (mkOccNameFS Name.varName fs) uniq (AnId id) UserSyntax
255
256 -- See Note [Kind-changing of (~) and Coercible]
257 -- in libraries/ghc-prim/GHC/Types.hs
258 eqTyConName, eqDataConName, eqSCSelIdName :: Name
259 eqTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "~") eqTyConKey eqTyCon
260 eqDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Eq#") eqDataConKey eqDataCon
261 eqSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "eq_sel") eqSCSelIdKey eqSCSelId
262
263 eqTyCon_RDR :: RdrName
264 eqTyCon_RDR = nameRdrName eqTyConName
265
266 -- See Note [Kind-changing of (~) and Coercible]
267 -- in libraries/ghc-prim/GHC/Types.hs
268 heqTyConName, heqDataConName, heqSCSelIdName :: Name
269 heqTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "~~") heqTyConKey heqTyCon
270 heqDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "HEq#") heqDataConKey heqDataCon
271 heqSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "heq_sel") heqSCSelIdKey heqSCSelId
272
273 -- See Note [Kind-changing of (~) and Coercible] in libraries/ghc-prim/GHC/Types.hs
274 coercibleTyConName, coercibleDataConName, coercibleSCSelIdName :: Name
275 coercibleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Coercible") coercibleTyConKey coercibleTyCon
276 coercibleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "MkCoercible") coercibleDataConKey coercibleDataCon
277 coercibleSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "coercible_sel") coercibleSCSelIdKey coercibleSCSelId
278
279 charTyConName, charDataConName, intTyConName, intDataConName :: Name
280 charTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Char") charTyConKey charTyCon
281 charDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "C#") charDataConKey charDataCon
282 intTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Int") intTyConKey intTyCon
283 intDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "I#") intDataConKey intDataCon
284
285 boolTyConName, falseDataConName, trueDataConName :: Name
286 boolTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Bool") boolTyConKey boolTyCon
287 falseDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "False") falseDataConKey falseDataCon
288 trueDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "True") trueDataConKey trueDataCon
289
290 listTyConName, nilDataConName, consDataConName :: Name
291 listTyConName = mkWiredInTyConName BuiltInSyntax gHC_TYPES (fsLit "[]") listTyConKey listTyCon
292 nilDataConName = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "[]") nilDataConKey nilDataCon
293 consDataConName = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit ":") consDataConKey consDataCon
294
295 maybeTyConName, nothingDataConName, justDataConName :: Name
296 maybeTyConName = mkWiredInTyConName UserSyntax gHC_MAYBE (fsLit "Maybe")
297 maybeTyConKey maybeTyCon
298 nothingDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Nothing")
299 nothingDataConKey nothingDataCon
300 justDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Just")
301 justDataConKey justDataCon
302
303 wordTyConName, wordDataConName, word8TyConName, word8DataConName :: Name
304 wordTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Word") wordTyConKey wordTyCon
305 wordDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "W#") wordDataConKey wordDataCon
306 word8TyConName = mkWiredInTyConName UserSyntax gHC_WORD (fsLit "Word8") word8TyConKey word8TyCon
307 word8DataConName = mkWiredInDataConName UserSyntax gHC_WORD (fsLit "W8#") word8DataConKey word8DataCon
308
309 floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name
310 floatTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Float") floatTyConKey floatTyCon
311 floatDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "F#") floatDataConKey floatDataCon
312 doubleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Double") doubleTyConKey doubleTyCon
313 doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") doubleDataConKey doubleDataCon
314
315 -- Any
316
317 {-
318 Note [Any types]
319 ~~~~~~~~~~~~~~~~
320 The type constructor Any,
321
322 type family Any :: k where { }
323
324 It has these properties:
325
326 * Note that 'Any' is kind polymorphic since in some program we may
327 need to use Any to fill in a type variable of some kind other than *
328 (see #959 for examples). Its kind is thus `forall k. k``.
329
330 * It is defined in module GHC.Types, and exported so that it is
331 available to users. For this reason it's treated like any other
332 wired-in type:
333 - has a fixed unique, anyTyConKey,
334 - lives in the global name cache
335
336 * It is a *closed* type family, with no instances. This means that
337 if ty :: '(k1, k2) we add a given coercion
338 g :: ty ~ (Fst ty, Snd ty)
339 If Any was a *data* type, then we'd get inconsistency because 'ty'
340 could be (Any '(k1,k2)) and then we'd have an equality with Any on
341 one side and '(,) on the other. See also #9097 and #9636.
342
343 * When instantiated at a lifted type it is inhabited by at least one value,
344 namely bottom
345
346 * You can safely coerce any /lifted/ type to Any, and back with unsafeCoerce.
347
348 * It does not claim to be a *data* type, and that's important for
349 the code generator, because the code gen may *enter* a data value
350 but never enters a function value.
351
352 * It is wired-in so we can easily refer to it where we don't have a name
353 environment (e.g. see Rules.matchRule for one example)
354
355 * If (Any k) is the type of a value, it must be a /lifted/ value. So
356 if we have (Any @(TYPE rr)) then rr must be 'LiftedRep. See
357 Note [TYPE and RuntimeRep] in TysPrim. This is a convenient
358 invariant, and makes isUnliftedTyCon well-defined; otherwise what
359 would (isUnliftedTyCon Any) be?
360
361 It's used to instantiate un-constrained type variables after type checking. For
362 example, 'length' has type
363
364 length :: forall a. [a] -> Int
365
366 and the list datacon for the empty list has type
367
368 [] :: forall a. [a]
369
370 In order to compose these two terms as @length []@ a type
371 application is required, but there is no constraint on the
372 choice. In this situation GHC uses 'Any',
373
374 > length (Any *) ([] (Any *))
375
376 Above, we print kinds explicitly, as if with --fprint-explicit-kinds.
377
378 The Any tycon used to be quite magic, but we have since been able to
379 implement it merely with an empty kind polymorphic type family. See #10886 for a
380 bit of history.
381 -}
382
383
384 anyTyConName :: Name
385 anyTyConName =
386 mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Any") anyTyConKey anyTyCon
387
388 anyTyCon :: TyCon
389 anyTyCon = mkFamilyTyCon anyTyConName binders res_kind Nothing
390 (ClosedSynFamilyTyCon Nothing)
391 Nothing
392 NotInjective
393 where
394 binders@[kv] = mkTemplateKindTyConBinders [liftedTypeKind]
395 res_kind = mkTyVarTy (binderVar kv)
396
397 anyTy :: Type
398 anyTy = mkTyConTy anyTyCon
399
400 anyTypeOfKind :: Kind -> Type
401 anyTypeOfKind kind = mkTyConApp anyTyCon [kind]
402
403 -- | Make a fake, recovery 'TyCon' from an existing one.
404 -- Used when recovering from errors in type declarations
405 makeRecoveryTyCon :: TyCon -> TyCon
406 makeRecoveryTyCon tc
407 = mkTcTyCon (tyConName tc)
408 bndrs res_kind
409 [] -- No scoped vars
410 True -- Fully generalised
411 flavour -- Keep old flavour
412 where
413 flavour = tyConFlavour tc
414 [kv] = mkTemplateKindVars [liftedTypeKind]
415 (bndrs, res_kind)
416 = case flavour of
417 PromotedDataConFlavour -> ([mkNamedTyConBinder Inferred kv], mkTyVarTy kv)
418 _ -> (tyConBinders tc, tyConResKind tc)
419 -- For data types we have already validated their kind, so it
420 -- makes sense to keep it. For promoted data constructors we haven't,
421 -- so we recover with kind (forall k. k). Otherwise consider
422 -- data T a where { MkT :: Show a => T a }
423 -- If T is for some reason invalid, we don't want to fall over
424 -- at (promoted) use-sites of MkT.
425
426 -- Kinds
427 typeNatKindConName, typeSymbolKindConName :: Name
428 typeNatKindConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Nat") typeNatKindConNameKey typeNatKindCon
429 typeSymbolKindConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Symbol") typeSymbolKindConNameKey typeSymbolKindCon
430
431 constraintKindTyConName :: Name
432 constraintKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Constraint") constraintKindTyConKey constraintKindTyCon
433
434 liftedTypeKindTyConName :: Name
435 liftedTypeKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Type") liftedTypeKindTyConKey liftedTypeKindTyCon
436
437 runtimeRepTyConName, vecRepDataConName, tupleRepDataConName, sumRepDataConName :: Name
438 runtimeRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "RuntimeRep") runtimeRepTyConKey runtimeRepTyCon
439 vecRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "VecRep") vecRepDataConKey vecRepDataCon
440 tupleRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "TupleRep") tupleRepDataConKey tupleRepDataCon
441 sumRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "SumRep") sumRepDataConKey sumRepDataCon
442
443 -- See Note [Wiring in RuntimeRep]
444 runtimeRepSimpleDataConNames :: [Name]
445 runtimeRepSimpleDataConNames
446 = zipWith3Lazy mk_special_dc_name
447 [ fsLit "LiftedRep", fsLit "UnliftedRep"
448 , fsLit "IntRep"
449 , fsLit "Int8Rep", fsLit "Int16Rep", fsLit "Int32Rep", fsLit "Int64Rep"
450 , fsLit "WordRep"
451 , fsLit "Word8Rep", fsLit "Word16Rep", fsLit "Word32Rep", fsLit "Word64Rep"
452 , fsLit "AddrRep"
453 , fsLit "FloatRep", fsLit "DoubleRep"
454 ]
455 runtimeRepSimpleDataConKeys
456 runtimeRepSimpleDataCons
457
458 vecCountTyConName :: Name
459 vecCountTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "VecCount") vecCountTyConKey vecCountTyCon
460
461 -- See Note [Wiring in RuntimeRep]
462 vecCountDataConNames :: [Name]
463 vecCountDataConNames = zipWith3Lazy mk_special_dc_name
464 [ fsLit "Vec2", fsLit "Vec4", fsLit "Vec8"
465 , fsLit "Vec16", fsLit "Vec32", fsLit "Vec64" ]
466 vecCountDataConKeys
467 vecCountDataCons
468
469 vecElemTyConName :: Name
470 vecElemTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "VecElem") vecElemTyConKey vecElemTyCon
471
472 -- See Note [Wiring in RuntimeRep]
473 vecElemDataConNames :: [Name]
474 vecElemDataConNames = zipWith3Lazy mk_special_dc_name
475 [ fsLit "Int8ElemRep", fsLit "Int16ElemRep", fsLit "Int32ElemRep"
476 , fsLit "Int64ElemRep", fsLit "Word8ElemRep", fsLit "Word16ElemRep"
477 , fsLit "Word32ElemRep", fsLit "Word64ElemRep"
478 , fsLit "FloatElemRep", fsLit "DoubleElemRep" ]
479 vecElemDataConKeys
480 vecElemDataCons
481
482 mk_special_dc_name :: FastString -> Unique -> DataCon -> Name
483 mk_special_dc_name fs u dc = mkWiredInDataConName UserSyntax gHC_TYPES fs u dc
484
485 boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR,
486 intDataCon_RDR, listTyCon_RDR, consDataCon_RDR :: RdrName
487 boolTyCon_RDR = nameRdrName boolTyConName
488 false_RDR = nameRdrName falseDataConName
489 true_RDR = nameRdrName trueDataConName
490 intTyCon_RDR = nameRdrName intTyConName
491 charTyCon_RDR = nameRdrName charTyConName
492 intDataCon_RDR = nameRdrName intDataConName
493 listTyCon_RDR = nameRdrName listTyConName
494 consDataCon_RDR = nameRdrName consDataConName
495
496 {-
497 ************************************************************************
498 * *
499 \subsection{mkWiredInTyCon}
500 * *
501 ************************************************************************
502 -}
503
504 -- This function assumes that the types it creates have all parameters at
505 -- Representational role, and that there is no kind polymorphism.
506 pcTyCon :: Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
507 pcTyCon name cType tyvars cons
508 = mkAlgTyCon name
509 (mkAnonTyConBinders VisArg tyvars)
510 liftedTypeKind
511 (map (const Representational) tyvars)
512 cType
513 [] -- No stupid theta
514 (mkDataTyConRhs cons)
515 (VanillaAlgTyCon (mkPrelTyConRepName name))
516 False -- Not in GADT syntax
517
518 pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
519 pcDataCon n univs = pcDataConWithFixity False n univs
520 [] -- no ex_tvs
521 univs -- the univs are precisely the user-written tyvars
522
523 pcDataConWithFixity :: Bool -- ^ declared infix?
524 -> Name -- ^ datacon name
525 -> [TyVar] -- ^ univ tyvars
526 -> [TyCoVar] -- ^ ex tycovars
527 -> [TyCoVar] -- ^ user-written tycovars
528 -> [Type] -- ^ args
529 -> TyCon
530 -> DataCon
531 pcDataConWithFixity infx n = pcDataConWithFixity' infx n (dataConWorkerUnique (nameUnique n))
532 NoRRI
533 -- The Name's unique is the first of two free uniques;
534 -- the first is used for the datacon itself,
535 -- the second is used for the "worker name"
536 --
537 -- To support this the mkPreludeDataConUnique function "allocates"
538 -- one DataCon unique per pair of Ints.
539
540 pcDataConWithFixity' :: Bool -> Name -> Unique -> RuntimeRepInfo
541 -> [TyVar] -> [TyCoVar] -> [TyCoVar]
542 -> [Type] -> TyCon -> DataCon
543 -- The Name should be in the DataName name space; it's the name
544 -- of the DataCon itself.
545
546 pcDataConWithFixity' declared_infix dc_name wrk_key rri
547 tyvars ex_tyvars user_tyvars arg_tys tycon
548 = data_con
549 where
550 tag_map = mkTyConTagMap tycon
551 -- This constructs the constructor Name to ConTag map once per
552 -- constructor, which is quadratic. It's OK here, because it's
553 -- only called for wired in data types that don't have a lot of
554 -- constructors. It's also likely that GHC will lift tag_map, since
555 -- we call pcDataConWithFixity' with static TyCons in the same module.
556 -- See Note [Constructor tag allocation] and #14657
557 data_con = mkDataCon dc_name declared_infix prom_info
558 (map (const no_bang) arg_tys)
559 [] -- No labelled fields
560 tyvars ex_tyvars
561 (mkTyCoVarBinders Specified user_tyvars)
562 [] -- No equality spec
563 [] -- No theta
564 arg_tys (mkTyConApp tycon (mkTyVarTys tyvars))
565 rri
566 tycon
567 (lookupNameEnv_NF tag_map dc_name)
568 [] -- No stupid theta
569 (mkDataConWorkId wrk_name data_con)
570 NoDataConRep -- Wired-in types are too simple to need wrappers
571
572 no_bang = HsSrcBang NoSourceText NoSrcUnpack NoSrcStrict
573
574 wrk_name = mkDataConWorkerName data_con wrk_key
575
576 prom_info = mkPrelTyConRepName dc_name
577
578 mkDataConWorkerName :: DataCon -> Unique -> Name
579 mkDataConWorkerName data_con wrk_key =
580 mkWiredInName modu wrk_occ wrk_key
581 (AnId (dataConWorkId data_con)) UserSyntax
582 where
583 modu = ASSERT( isExternalName dc_name )
584 nameModule dc_name
585 dc_name = dataConName data_con
586 dc_occ = nameOccName dc_name
587 wrk_occ = mkDataConWorkerOcc dc_occ
588
589 -- used for RuntimeRep and friends
590 pcSpecialDataCon :: Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
591 pcSpecialDataCon dc_name arg_tys tycon rri
592 = pcDataConWithFixity' False dc_name (dataConWorkerUnique (nameUnique dc_name)) rri
593 [] [] [] arg_tys tycon
594
595 {-
596 ************************************************************************
597 * *
598 Kinds
599 * *
600 ************************************************************************
601 -}
602
603 typeNatKindCon, typeSymbolKindCon :: TyCon
604 -- data Nat
605 -- data Symbol
606 typeNatKindCon = pcTyCon typeNatKindConName Nothing [] []
607 typeSymbolKindCon = pcTyCon typeSymbolKindConName Nothing [] []
608
609 typeNatKind, typeSymbolKind :: Kind
610 typeNatKind = mkTyConTy typeNatKindCon
611 typeSymbolKind = mkTyConTy typeSymbolKindCon
612
613 constraintKindTyCon :: TyCon
614 constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] []
615
616 liftedTypeKind, constraintKind :: Kind
617 liftedTypeKind = tYPE liftedRepTy
618 constraintKind = mkTyConApp constraintKindTyCon []
619
620 {-
621 ************************************************************************
622 * *
623 Stuff for dealing with tuples
624 * *
625 ************************************************************************
626
627 Note [How tuples work] See also Note [Known-key names] in PrelNames
628 ~~~~~~~~~~~~~~~~~~~~~~
629 * There are three families of tuple TyCons and corresponding
630 DataCons, expressed by the type BasicTypes.TupleSort:
631 data TupleSort = BoxedTuple | UnboxedTuple | ConstraintTuple
632
633 * All three families are AlgTyCons, whose AlgTyConRhs is TupleTyCon
634
635 * BoxedTuples
636 - A wired-in type
637 - Data type declarations in GHC.Tuple
638 - The data constructors really have an info table
639
640 * UnboxedTuples
641 - A wired-in type
642 - Have a pretend DataCon, defined in GHC.Prim,
643 but no actual declaration and no info table
644
645 * ConstraintTuples
646 - Are known-key rather than wired-in. Reason: it's awkward to
647 have all the superclass selectors wired-in.
648 - Declared as classes in GHC.Classes, e.g.
649 class (c1,c2) => (c1,c2)
650 - Given constraints: the superclasses automatically become available
651 - Wanted constraints: there is a built-in instance
652 instance (c1,c2) => (c1,c2)
653 See TcInteract.matchCTuple
654 - Currently just go up to 62; beyond that
655 you have to use manual nesting
656 - Their OccNames look like (%,,,%), so they can easily be
657 distinguished from term tuples. But (following Haskell) we
658 pretty-print saturated constraint tuples with round parens;
659 see BasicTypes.tupleParens.
660
661 * In quite a lot of places things are restrcted just to
662 BoxedTuple/UnboxedTuple, and then we used BasicTypes.Boxity to distinguish
663 E.g. tupleTyCon has a Boxity argument
664
665 * When looking up an OccName in the original-name cache
666 (IfaceEnv.lookupOrigNameCache), we spot the tuple OccName to make sure
667 we get the right wired-in name. This guy can't tell the difference
668 between BoxedTuple and ConstraintTuple (same OccName!), so tuples
669 are not serialised into interface files using OccNames at all.
670
671 * Serialization to interface files works via the usual mechanism for known-key
672 things: instead of serializing the OccName we just serialize the key. During
673 deserialization we lookup the Name associated with the unique with the logic
674 in KnownUniques. See Note [Symbol table representation of names] for details.
675
676 Note [One-tuples]
677 ~~~~~~~~~~~~~~~~~
678 GHC supports both boxed and unboxed one-tuples:
679 - Unboxed one-tuples are sometimes useful when returning a
680 single value after CPR analysis
681 - A boxed one-tuple is used by DsUtils.mkSelectorBinds, when
682 there is just one binder
683 Basically it keeps everythig uniform.
684
685 However the /naming/ of the type/data constructors for one-tuples is a
686 bit odd:
687 3-tuples: (,,) (,,)#
688 2-tuples: (,) (,)#
689 1-tuples: ??
690 0-tuples: () ()#
691
692 Zero-tuples have used up the logical name. So we use 'Unit' and 'Unit#'
693 for one-tuples. So in ghc-prim:GHC.Tuple we see the declarations:
694 data () = ()
695 data Unit a = Unit a
696 data (a,b) = (a,b)
697
698 NB (Feb 16): for /constraint/ one-tuples I have 'Unit%' but no class
699 decl in GHC.Classes, so I think this part may not work properly. But
700 it's unused I think.
701 -}
702
703 -- | Built-in syntax isn't "in scope" so these OccNames map to wired-in Names
704 -- with BuiltInSyntax. However, this should only be necessary while resolving
705 -- names produced by Template Haskell splices since we take care to encode
706 -- built-in syntax names specially in interface files. See
707 -- Note [Symbol table representation of names].
708 --
709 -- Moreover, there is no need to include names of things that the user can't
710 -- write (e.g. type representation bindings like $tc(,,,)).
711 isBuiltInOcc_maybe :: OccName -> Maybe Name
712 isBuiltInOcc_maybe occ =
713 case name of
714 "[]" -> Just $ choose_ns listTyConName nilDataConName
715 ":" -> Just consDataConName
716
717 -- equality tycon
718 "~" -> Just eqTyConName
719
720 -- function tycon
721 "->" -> Just funTyConName
722
723 -- boxed tuple data/tycon
724 "()" -> Just $ tup_name Boxed 0
725 _ | Just rest <- "(" `BS.stripPrefix` name
726 , (commas, rest') <- BS.span (==',') rest
727 , ")" <- rest'
728 -> Just $ tup_name Boxed (1+BS.length commas)
729
730 -- unboxed tuple data/tycon
731 "(##)" -> Just $ tup_name Unboxed 0
732 "Unit#" -> Just $ tup_name Unboxed 1
733 _ | Just rest <- "(#" `BS.stripPrefix` name
734 , (commas, rest') <- BS.span (==',') rest
735 , "#)" <- rest'
736 -> Just $ tup_name Unboxed (1+BS.length commas)
737
738 -- unboxed sum tycon
739 _ | Just rest <- "(#" `BS.stripPrefix` name
740 , (pipes, rest') <- BS.span (=='|') rest
741 , "#)" <- rest'
742 -> Just $ tyConName $ sumTyCon (1+BS.length pipes)
743
744 -- unboxed sum datacon
745 _ | Just rest <- "(#" `BS.stripPrefix` name
746 , (pipes1, rest') <- BS.span (=='|') rest
747 , Just rest'' <- "_" `BS.stripPrefix` rest'
748 , (pipes2, rest''') <- BS.span (=='|') rest''
749 , "#)" <- rest'''
750 -> let arity = BS.length pipes1 + BS.length pipes2 + 1
751 alt = BS.length pipes1 + 1
752 in Just $ dataConName $ sumDataCon alt arity
753 _ -> Nothing
754 where
755 name = bytesFS $ occNameFS occ
756
757 choose_ns :: Name -> Name -> Name
758 choose_ns tc dc
759 | isTcClsNameSpace ns = tc
760 | isDataConNameSpace ns = dc
761 | otherwise = pprPanic "tup_name" (ppr occ)
762 where ns = occNameSpace occ
763
764 tup_name boxity arity
765 = choose_ns (getName (tupleTyCon boxity arity))
766 (getName (tupleDataCon boxity arity))
767
768 mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
769 -- No need to cache these, the caching is done in mk_tuple
770 mkTupleOcc ns Boxed ar = mkOccName ns (mkBoxedTupleStr ar)
771 mkTupleOcc ns Unboxed ar = mkOccName ns (mkUnboxedTupleStr ar)
772
773 mkCTupleOcc :: NameSpace -> Arity -> OccName
774 mkCTupleOcc ns ar = mkOccName ns (mkConstraintTupleStr ar)
775
776 mkBoxedTupleStr :: Arity -> String
777 mkBoxedTupleStr 0 = "()"
778 mkBoxedTupleStr 1 = "Unit" -- See Note [One-tuples]
779 mkBoxedTupleStr ar = '(' : commas ar ++ ")"
780
781 mkUnboxedTupleStr :: Arity -> String
782 mkUnboxedTupleStr 0 = "(##)"
783 mkUnboxedTupleStr 1 = "Unit#" -- See Note [One-tuples]
784 mkUnboxedTupleStr ar = "(#" ++ commas ar ++ "#)"
785
786 mkConstraintTupleStr :: Arity -> String
787 mkConstraintTupleStr 0 = "(%%)"
788 mkConstraintTupleStr 1 = "Unit%" -- See Note [One-tuples]
789 mkConstraintTupleStr ar = "(%" ++ commas ar ++ "%)"
790
791 commas :: Arity -> String
792 commas ar = take (ar-1) (repeat ',')
793
794 cTupleTyConName :: Arity -> Name
795 cTupleTyConName arity
796 = mkExternalName (mkCTupleTyConUnique arity) gHC_CLASSES
797 (mkCTupleOcc tcName arity) noSrcSpan
798
799 cTupleTyConNames :: [Name]
800 cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE])
801
802 cTupleTyConNameSet :: NameSet
803 cTupleTyConNameSet = mkNameSet cTupleTyConNames
804
805 isCTupleTyConName :: Name -> Bool
806 -- Use Type.isCTupleClass where possible
807 isCTupleTyConName n
808 = ASSERT2( isExternalName n, ppr n )
809 nameModule n == gHC_CLASSES
810 && n `elemNameSet` cTupleTyConNameSet
811
812 -- | If the given name is that of a constraint tuple, return its arity.
813 -- Note that this is inefficient.
814 cTupleTyConNameArity_maybe :: Name -> Maybe Arity
815 cTupleTyConNameArity_maybe n
816 | not (isCTupleTyConName n) = Nothing
817 | otherwise = fmap adjustArity (n `elemIndex` cTupleTyConNames)
818 where
819 -- Since `cTupleTyConNames` jumps straight from the `0` to the `2`
820 -- case, we have to adjust accordingly our calculated arity.
821 adjustArity a = if a > 0 then a + 1 else a
822
823 cTupleDataConName :: Arity -> Name
824 cTupleDataConName arity
825 = mkExternalName (mkCTupleDataConUnique arity) gHC_CLASSES
826 (mkCTupleOcc dataName arity) noSrcSpan
827
828 cTupleDataConNames :: [Name]
829 cTupleDataConNames = map cTupleDataConName (0 : [2..mAX_CTUPLE_SIZE])
830
831 tupleTyCon :: Boxity -> Arity -> TyCon
832 tupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i) -- Build one specially
833 tupleTyCon Boxed i = fst (boxedTupleArr ! i)
834 tupleTyCon Unboxed i = fst (unboxedTupleArr ! i)
835
836 tupleTyConName :: TupleSort -> Arity -> Name
837 tupleTyConName ConstraintTuple a = cTupleTyConName a
838 tupleTyConName BoxedTuple a = tyConName (tupleTyCon Boxed a)
839 tupleTyConName UnboxedTuple a = tyConName (tupleTyCon Unboxed a)
840
841 promotedTupleDataCon :: Boxity -> Arity -> TyCon
842 promotedTupleDataCon boxity i = promoteDataCon (tupleDataCon boxity i)
843
844 tupleDataCon :: Boxity -> Arity -> DataCon
845 tupleDataCon sort i | i > mAX_TUPLE_SIZE = snd (mk_tuple sort i) -- Build one specially
846 tupleDataCon Boxed i = snd (boxedTupleArr ! i)
847 tupleDataCon Unboxed i = snd (unboxedTupleArr ! i)
848
849 boxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon)
850 boxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Boxed i | i <- [0..mAX_TUPLE_SIZE]]
851 unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mAX_TUPLE_SIZE]]
852
853 -- | Given the TupleRep/SumRep tycon and list of RuntimeReps of the unboxed
854 -- tuple/sum arguments, produces the return kind of an unboxed tuple/sum type
855 -- constructor. @unboxedTupleSumKind [IntRep, LiftedRep] --> TYPE (TupleRep/SumRep
856 -- [IntRep, LiftedRep])@
857 unboxedTupleSumKind :: TyCon -> [Type] -> Kind
858 unboxedTupleSumKind tc rr_tys
859 = tYPE (mkTyConApp tc [mkPromotedListTy runtimeRepTy rr_tys])
860
861 -- | Specialization of 'unboxedTupleSumKind' for tuples
862 unboxedTupleKind :: [Type] -> Kind
863 unboxedTupleKind = unboxedTupleSumKind tupleRepDataConTyCon
864
865 mk_tuple :: Boxity -> Int -> (TyCon,DataCon)
866 mk_tuple Boxed arity = (tycon, tuple_con)
867 where
868 tycon = mkTupleTyCon tc_name tc_binders tc_res_kind tc_arity tuple_con
869 BoxedTuple flavour
870
871 tc_binders = mkTemplateAnonTyConBinders (replicate arity liftedTypeKind)
872 tc_res_kind = liftedTypeKind
873 tc_arity = arity
874 flavour = VanillaAlgTyCon (mkPrelTyConRepName tc_name)
875
876 dc_tvs = binderVars tc_binders
877 dc_arg_tys = mkTyVarTys dc_tvs
878 tuple_con = pcDataCon dc_name dc_tvs dc_arg_tys tycon
879
880 boxity = Boxed
881 modu = gHC_TUPLE
882 tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
883 (ATyCon tycon) BuiltInSyntax
884 dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq
885 (AConLike (RealDataCon tuple_con)) BuiltInSyntax
886 tc_uniq = mkTupleTyConUnique boxity arity
887 dc_uniq = mkTupleDataConUnique boxity arity
888
889 mk_tuple Unboxed arity = (tycon, tuple_con)
890 where
891 tycon = mkTupleTyCon tc_name tc_binders tc_res_kind tc_arity tuple_con
892 UnboxedTuple flavour
893
894 -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
895 -- Kind: forall (k1:RuntimeRep) (k2:RuntimeRep). TYPE k1 -> TYPE k2 -> #
896 tc_binders = mkTemplateTyConBinders (replicate arity runtimeRepTy)
897 (\ks -> map tYPE ks)
898
899 tc_res_kind = unboxedTupleKind rr_tys
900
901 tc_arity = arity * 2
902 flavour = UnboxedAlgTyCon $ Just (mkPrelTyConRepName tc_name)
903
904 dc_tvs = binderVars tc_binders
905 (rr_tys, dc_arg_tys) = splitAt arity (mkTyVarTys dc_tvs)
906 tuple_con = pcDataCon dc_name dc_tvs dc_arg_tys tycon
907
908 boxity = Unboxed
909 modu = gHC_PRIM
910 tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
911 (ATyCon tycon) BuiltInSyntax
912 dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq
913 (AConLike (RealDataCon tuple_con)) BuiltInSyntax
914 tc_uniq = mkTupleTyConUnique boxity arity
915 dc_uniq = mkTupleDataConUnique boxity arity
916
917 unitTyCon :: TyCon
918 unitTyCon = tupleTyCon Boxed 0
919
920 unitTyConKey :: Unique
921 unitTyConKey = getUnique unitTyCon
922
923 unitDataCon :: DataCon
924 unitDataCon = head (tyConDataCons unitTyCon)
925
926 unitDataConId :: Id
927 unitDataConId = dataConWorkId unitDataCon
928
929 pairTyCon :: TyCon
930 pairTyCon = tupleTyCon Boxed 2
931
932 unboxedUnitTyCon :: TyCon
933 unboxedUnitTyCon = tupleTyCon Unboxed 0
934
935 unboxedUnitDataCon :: DataCon
936 unboxedUnitDataCon = tupleDataCon Unboxed 0
937
938
939 {- *********************************************************************
940 * *
941 Unboxed sums
942 * *
943 ********************************************************************* -}
944
945 -- | OccName for n-ary unboxed sum type constructor.
946 mkSumTyConOcc :: Arity -> OccName
947 mkSumTyConOcc n = mkOccName tcName str
948 where
949 -- No need to cache these, the caching is done in mk_sum
950 str = '(' : '#' : bars ++ "#)"
951 bars = replicate (n-1) '|'
952
953 -- | OccName for i-th alternative of n-ary unboxed sum data constructor.
954 mkSumDataConOcc :: ConTag -> Arity -> OccName
955 mkSumDataConOcc alt n = mkOccName dataName str
956 where
957 -- No need to cache these, the caching is done in mk_sum
958 str = '(' : '#' : bars alt ++ '_' : bars (n - alt - 1) ++ "#)"
959 bars i = replicate i '|'
960
961 -- | Type constructor for n-ary unboxed sum.
962 sumTyCon :: Arity -> TyCon
963 sumTyCon arity
964 | arity > mAX_SUM_SIZE
965 = fst (mk_sum arity) -- Build one specially
966
967 | arity < 2
968 = panic ("sumTyCon: Arity starts from 2. (arity: " ++ show arity ++ ")")
969
970 | otherwise
971 = fst (unboxedSumArr ! arity)
972
973 -- | Data constructor for i-th alternative of a n-ary unboxed sum.
974 sumDataCon :: ConTag -- Alternative
975 -> Arity -- Arity
976 -> DataCon
977 sumDataCon alt arity
978 | alt > arity
979 = panic ("sumDataCon: index out of bounds: alt: "
980 ++ show alt ++ " > arity " ++ show arity)
981
982 | alt <= 0
983 = panic ("sumDataCon: Alts start from 1. (alt: " ++ show alt
984 ++ ", arity: " ++ show arity ++ ")")
985
986 | arity < 2
987 = panic ("sumDataCon: Arity starts from 2. (alt: " ++ show alt
988 ++ ", arity: " ++ show arity ++ ")")
989
990 | arity > mAX_SUM_SIZE
991 = snd (mk_sum arity) ! (alt - 1) -- Build one specially
992
993 | otherwise
994 = snd (unboxedSumArr ! arity) ! (alt - 1)
995
996 -- | Cached type and data constructors for sums. The outer array is
997 -- indexed by the arity of the sum and the inner array is indexed by
998 -- the alternative.
999 unboxedSumArr :: Array Int (TyCon, Array Int DataCon)
1000 unboxedSumArr = listArray (2,mAX_SUM_SIZE) [mk_sum i | i <- [2..mAX_SUM_SIZE]]
1001
1002 -- | Specialization of 'unboxedTupleSumKind' for sums
1003 unboxedSumKind :: [Type] -> Kind
1004 unboxedSumKind = unboxedTupleSumKind sumRepDataConTyCon
1005
1006 -- | Create type constructor and data constructors for n-ary unboxed sum.
1007 mk_sum :: Arity -> (TyCon, Array ConTagZ DataCon)
1008 mk_sum arity = (tycon, sum_cons)
1009 where
1010 tycon = mkSumTyCon tc_name tc_binders tc_res_kind (arity * 2) tyvars (elems sum_cons)
1011 (UnboxedAlgTyCon rep_name)
1012
1013 -- Unboxed sums are currently not Typeable due to efficiency concerns. See #13276.
1014 rep_name = Nothing -- Just $ mkPrelTyConRepName tc_name
1015
1016 tc_binders = mkTemplateTyConBinders (replicate arity runtimeRepTy)
1017 (\ks -> map tYPE ks)
1018
1019 tyvars = binderVars tc_binders
1020
1021 tc_res_kind = unboxedSumKind rr_tys
1022
1023 (rr_tys, tyvar_tys) = splitAt arity (mkTyVarTys tyvars)
1024
1025 tc_name = mkWiredInName gHC_PRIM (mkSumTyConOcc arity) tc_uniq
1026 (ATyCon tycon) BuiltInSyntax
1027
1028 sum_cons = listArray (0,arity-1) [sum_con i | i <- [0..arity-1]]
1029 sum_con i = let dc = pcDataCon dc_name
1030 tyvars -- univ tyvars
1031 [tyvar_tys !! i] -- arg types
1032 tycon
1033
1034 dc_name = mkWiredInName gHC_PRIM
1035 (mkSumDataConOcc i arity)
1036 (dc_uniq i)
1037 (AConLike (RealDataCon dc))
1038 BuiltInSyntax
1039 in dc
1040
1041 tc_uniq = mkSumTyConUnique arity
1042 dc_uniq i = mkSumDataConUnique i arity
1043
1044 {-
1045 ************************************************************************
1046 * *
1047 Equality types and classes
1048 * *
1049 ********************************************************************* -}
1050
1051 -- See Note [The equality types story] in TysPrim
1052 -- ((~~) :: forall k1 k2 (a :: k1) (b :: k2). a -> b -> Constraint)
1053 --
1054 -- It's tempting to put functional dependencies on (~~), but it's not
1055 -- necessary because the functional-dependency coverage check looks
1056 -- through superclasses, and (~#) is handled in that check.
1057
1058 eqTyCon, heqTyCon, coercibleTyCon :: TyCon
1059 eqClass, heqClass, coercibleClass :: Class
1060 eqDataCon, heqDataCon, coercibleDataCon :: DataCon
1061 eqSCSelId, heqSCSelId, coercibleSCSelId :: Id
1062
1063 (eqTyCon, eqClass, eqDataCon, eqSCSelId)
1064 = (tycon, klass, datacon, sc_sel_id)
1065 where
1066 tycon = mkClassTyCon eqTyConName binders roles
1067 rhs klass
1068 (mkPrelTyConRepName eqTyConName)
1069 klass = mk_class tycon sc_pred sc_sel_id
1070 datacon = pcDataCon eqDataConName tvs [sc_pred] tycon
1071
1072 -- Kind: forall k. k -> k -> Constraint
1073 binders = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k,k])
1074 roles = [Nominal, Nominal, Nominal]
1075 rhs = mkDataTyConRhs [datacon]
1076
1077 tvs@[k,a,b] = binderVars binders
1078 sc_pred = mkTyConApp eqPrimTyCon (mkTyVarTys [k,k,a,b])
1079 sc_sel_id = mkDictSelId eqSCSelIdName klass
1080
1081 (heqTyCon, heqClass, heqDataCon, heqSCSelId)
1082 = (tycon, klass, datacon, sc_sel_id)
1083 where
1084 tycon = mkClassTyCon heqTyConName binders roles
1085 rhs klass
1086 (mkPrelTyConRepName heqTyConName)
1087 klass = mk_class tycon sc_pred sc_sel_id
1088 datacon = pcDataCon heqDataConName tvs [sc_pred] tycon
1089
1090 -- Kind: forall k1 k2. k1 -> k2 -> Constraint
1091 binders = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id
1092 roles = [Nominal, Nominal, Nominal, Nominal]
1093 rhs = mkDataTyConRhs [datacon]
1094
1095 tvs = binderVars binders
1096 sc_pred = mkTyConApp eqPrimTyCon (mkTyVarTys tvs)
1097 sc_sel_id = mkDictSelId heqSCSelIdName klass
1098
1099 (coercibleTyCon, coercibleClass, coercibleDataCon, coercibleSCSelId)
1100 = (tycon, klass, datacon, sc_sel_id)
1101 where
1102 tycon = mkClassTyCon coercibleTyConName binders roles
1103 rhs klass
1104 (mkPrelTyConRepName coercibleTyConName)
1105 klass = mk_class tycon sc_pred sc_sel_id
1106 datacon = pcDataCon coercibleDataConName tvs [sc_pred] tycon
1107
1108 -- Kind: forall k. k -> k -> Constraint
1109 binders = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k,k])
1110 roles = [Nominal, Representational, Representational]
1111 rhs = mkDataTyConRhs [datacon]
1112
1113 tvs@[k,a,b] = binderVars binders
1114 sc_pred = mkTyConApp eqReprPrimTyCon (mkTyVarTys [k, k, a, b])
1115 sc_sel_id = mkDictSelId coercibleSCSelIdName klass
1116
1117 mk_class :: TyCon -> PredType -> Id -> Class
1118 mk_class tycon sc_pred sc_sel_id
1119 = mkClass (tyConName tycon) (tyConTyVars tycon) [] [sc_pred] [sc_sel_id]
1120 [] [] (mkAnd []) tycon
1121
1122
1123
1124 {- *********************************************************************
1125 * *
1126 Kinds and RuntimeRep
1127 * *
1128 ********************************************************************* -}
1129
1130 -- For information about the usage of the following type,
1131 -- see Note [TYPE and RuntimeRep] in module TysPrim
1132 runtimeRepTy :: Type
1133 runtimeRepTy = mkTyConTy runtimeRepTyCon
1134
1135 -- Type synonyms; see Note [TYPE and RuntimeRep] in TysPrim
1136 -- type Type = tYPE 'LiftedRep
1137 liftedTypeKindTyCon :: TyCon
1138 liftedTypeKindTyCon = buildSynTyCon liftedTypeKindTyConName
1139 [] liftedTypeKind []
1140 (tYPE liftedRepTy)
1141
1142 runtimeRepTyCon :: TyCon
1143 runtimeRepTyCon = pcTyCon runtimeRepTyConName Nothing []
1144 (vecRepDataCon : tupleRepDataCon :
1145 sumRepDataCon : runtimeRepSimpleDataCons)
1146
1147 vecRepDataCon :: DataCon
1148 vecRepDataCon = pcSpecialDataCon vecRepDataConName [ mkTyConTy vecCountTyCon
1149 , mkTyConTy vecElemTyCon ]
1150 runtimeRepTyCon
1151 (RuntimeRep prim_rep_fun)
1152 where
1153 -- See Note [Getting from RuntimeRep to PrimRep] in RepType
1154 prim_rep_fun [count, elem]
1155 | VecCount n <- tyConRuntimeRepInfo (tyConAppTyCon count)
1156 , VecElem e <- tyConRuntimeRepInfo (tyConAppTyCon elem)
1157 = [VecRep n e]
1158 prim_rep_fun args
1159 = pprPanic "vecRepDataCon" (ppr args)
1160
1161 vecRepDataConTyCon :: TyCon
1162 vecRepDataConTyCon = promoteDataCon vecRepDataCon
1163
1164 tupleRepDataCon :: DataCon
1165 tupleRepDataCon = pcSpecialDataCon tupleRepDataConName [ mkListTy runtimeRepTy ]
1166 runtimeRepTyCon (RuntimeRep prim_rep_fun)
1167 where
1168 -- See Note [Getting from RuntimeRep to PrimRep] in RepType
1169 prim_rep_fun [rr_ty_list]
1170 = concatMap (runtimeRepPrimRep doc) rr_tys
1171 where
1172 rr_tys = extractPromotedList rr_ty_list
1173 doc = text "tupleRepDataCon" <+> ppr rr_tys
1174 prim_rep_fun args
1175 = pprPanic "tupleRepDataCon" (ppr args)
1176
1177 tupleRepDataConTyCon :: TyCon
1178 tupleRepDataConTyCon = promoteDataCon tupleRepDataCon
1179
1180 sumRepDataCon :: DataCon
1181 sumRepDataCon = pcSpecialDataCon sumRepDataConName [ mkListTy runtimeRepTy ]
1182 runtimeRepTyCon (RuntimeRep prim_rep_fun)
1183 where
1184 -- See Note [Getting from RuntimeRep to PrimRep] in RepType
1185 prim_rep_fun [rr_ty_list]
1186 = map slotPrimRep (ubxSumRepType prim_repss)
1187 where
1188 rr_tys = extractPromotedList rr_ty_list
1189 doc = text "sumRepDataCon" <+> ppr rr_tys
1190 prim_repss = map (runtimeRepPrimRep doc) rr_tys
1191 prim_rep_fun args
1192 = pprPanic "sumRepDataCon" (ppr args)
1193
1194 sumRepDataConTyCon :: TyCon
1195 sumRepDataConTyCon = promoteDataCon sumRepDataCon
1196
1197 -- See Note [Wiring in RuntimeRep]
1198 -- See Note [Getting from RuntimeRep to PrimRep] in RepType
1199 runtimeRepSimpleDataCons :: [DataCon]
1200 liftedRepDataCon :: DataCon
1201 runtimeRepSimpleDataCons@(liftedRepDataCon : _)
1202 = zipWithLazy mk_runtime_rep_dc
1203 [ LiftedRep, UnliftedRep
1204 , IntRep
1205 , Int8Rep, Int16Rep, Int32Rep, Int64Rep
1206 , WordRep
1207 , Word8Rep, Word16Rep, Word32Rep, Word64Rep
1208 , AddrRep
1209 , FloatRep, DoubleRep
1210 ]
1211 runtimeRepSimpleDataConNames
1212 where
1213 mk_runtime_rep_dc primrep name
1214 = pcSpecialDataCon name [] runtimeRepTyCon (RuntimeRep (\_ -> [primrep]))
1215
1216 -- See Note [Wiring in RuntimeRep]
1217 liftedRepDataConTy, unliftedRepDataConTy,
1218 intRepDataConTy,
1219 int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
1220 wordRepDataConTy,
1221 word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,
1222 addrRepDataConTy,
1223 floatRepDataConTy, doubleRepDataConTy :: Type
1224 [liftedRepDataConTy, unliftedRepDataConTy,
1225 intRepDataConTy,
1226 int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
1227 wordRepDataConTy,
1228 word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,
1229 addrRepDataConTy,
1230 floatRepDataConTy, doubleRepDataConTy
1231 ]
1232 = map (mkTyConTy . promoteDataCon) runtimeRepSimpleDataCons
1233
1234 vecCountTyCon :: TyCon
1235 vecCountTyCon = pcTyCon vecCountTyConName Nothing [] vecCountDataCons
1236
1237 -- See Note [Wiring in RuntimeRep]
1238 vecCountDataCons :: [DataCon]
1239 vecCountDataCons = zipWithLazy mk_vec_count_dc
1240 [ 2, 4, 8, 16, 32, 64 ]
1241 vecCountDataConNames
1242 where
1243 mk_vec_count_dc n name
1244 = pcSpecialDataCon name [] vecCountTyCon (VecCount n)
1245
1246 -- See Note [Wiring in RuntimeRep]
1247 vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
1248 vec64DataConTy :: Type
1249 [vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
1250 vec64DataConTy] = map (mkTyConTy . promoteDataCon) vecCountDataCons
1251
1252 vecElemTyCon :: TyCon
1253 vecElemTyCon = pcTyCon vecElemTyConName Nothing [] vecElemDataCons
1254
1255 -- See Note [Wiring in RuntimeRep]
1256 vecElemDataCons :: [DataCon]
1257 vecElemDataCons = zipWithLazy mk_vec_elem_dc
1258 [ Int8ElemRep, Int16ElemRep, Int32ElemRep, Int64ElemRep
1259 , Word8ElemRep, Word16ElemRep, Word32ElemRep, Word64ElemRep
1260 , FloatElemRep, DoubleElemRep ]
1261 vecElemDataConNames
1262 where
1263 mk_vec_elem_dc elem name
1264 = pcSpecialDataCon name [] vecElemTyCon (VecElem elem)
1265
1266 -- See Note [Wiring in RuntimeRep]
1267 int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
1268 int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
1269 word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,
1270 doubleElemRepDataConTy :: Type
1271 [int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
1272 int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
1273 word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,
1274 doubleElemRepDataConTy] = map (mkTyConTy . promoteDataCon)
1275 vecElemDataCons
1276
1277 liftedRepDataConTyCon :: TyCon
1278 liftedRepDataConTyCon = promoteDataCon liftedRepDataCon
1279
1280 -- The type ('LiftedRep)
1281 liftedRepTy :: Type
1282 liftedRepTy = liftedRepDataConTy
1283
1284 {- *********************************************************************
1285 * *
1286 The boxed primitive types: Char, Int, etc
1287 * *
1288 ********************************************************************* -}
1289
1290 boxingDataCon_maybe :: TyCon -> Maybe DataCon
1291 -- boxingDataCon_maybe Char# = C#
1292 -- boxingDataCon_maybe Int# = I#
1293 -- ... etc ...
1294 -- See Note [Boxing primitive types]
1295 boxingDataCon_maybe tc
1296 = lookupNameEnv boxing_constr_env (tyConName tc)
1297
1298 boxing_constr_env :: NameEnv DataCon
1299 boxing_constr_env
1300 = mkNameEnv [(charPrimTyConName , charDataCon )
1301 ,(intPrimTyConName , intDataCon )
1302 ,(wordPrimTyConName , wordDataCon )
1303 ,(floatPrimTyConName , floatDataCon )
1304 ,(doublePrimTyConName, doubleDataCon) ]
1305
1306 {- Note [Boxing primitive types]
1307 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1308 For a handful of primitive types (Int, Char, Word, Flaot, Double),
1309 we can readily box and an unboxed version (Int#, Char# etc) using
1310 the corresponding data constructor. This is useful in a couple
1311 of places, notably let-floating -}
1312
1313
1314 charTy :: Type
1315 charTy = mkTyConTy charTyCon
1316
1317 charTyCon :: TyCon
1318 charTyCon = pcTyCon charTyConName
1319 (Just (CType NoSourceText Nothing
1320 (NoSourceText,fsLit "HsChar")))
1321 [] [charDataCon]
1322 charDataCon :: DataCon
1323 charDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon
1324
1325 stringTy :: Type
1326 stringTy = mkListTy charTy -- convenience only
1327
1328 intTy :: Type
1329 intTy = mkTyConTy intTyCon
1330
1331 intTyCon :: TyCon
1332 intTyCon = pcTyCon intTyConName
1333 (Just (CType NoSourceText Nothing (NoSourceText,fsLit "HsInt")))
1334 [] [intDataCon]
1335 intDataCon :: DataCon
1336 intDataCon = pcDataCon intDataConName [] [intPrimTy] intTyCon
1337
1338 wordTy :: Type
1339 wordTy = mkTyConTy wordTyCon
1340
1341 wordTyCon :: TyCon
1342 wordTyCon = pcTyCon wordTyConName
1343 (Just (CType NoSourceText Nothing (NoSourceText, fsLit "HsWord")))
1344 [] [wordDataCon]
1345 wordDataCon :: DataCon
1346 wordDataCon = pcDataCon wordDataConName [] [wordPrimTy] wordTyCon
1347
1348 word8Ty :: Type
1349 word8Ty = mkTyConTy word8TyCon
1350
1351 word8TyCon :: TyCon
1352 word8TyCon = pcTyCon word8TyConName
1353 (Just (CType NoSourceText Nothing
1354 (NoSourceText, fsLit "HsWord8"))) []
1355 [word8DataCon]
1356 word8DataCon :: DataCon
1357 word8DataCon = pcDataCon word8DataConName [] [wordPrimTy] word8TyCon
1358
1359 floatTy :: Type
1360 floatTy = mkTyConTy floatTyCon
1361
1362 floatTyCon :: TyCon
1363 floatTyCon = pcTyCon floatTyConName
1364 (Just (CType NoSourceText Nothing
1365 (NoSourceText, fsLit "HsFloat"))) []
1366 [floatDataCon]
1367 floatDataCon :: DataCon
1368 floatDataCon = pcDataCon floatDataConName [] [floatPrimTy] floatTyCon
1369
1370 doubleTy :: Type
1371 doubleTy = mkTyConTy doubleTyCon
1372
1373 doubleTyCon :: TyCon
1374 doubleTyCon = pcTyCon doubleTyConName
1375 (Just (CType NoSourceText Nothing
1376 (NoSourceText,fsLit "HsDouble"))) []
1377 [doubleDataCon]
1378
1379 doubleDataCon :: DataCon
1380 doubleDataCon = pcDataCon doubleDataConName [] [doublePrimTy] doubleTyCon
1381
1382 {-
1383 ************************************************************************
1384 * *
1385 The Bool type
1386 * *
1387 ************************************************************************
1388
1389 An ordinary enumeration type, but deeply wired in. There are no
1390 magical operations on @Bool@ (just the regular Prelude code).
1391
1392 {\em BEGIN IDLE SPECULATION BY SIMON}
1393
1394 This is not the only way to encode @Bool@. A more obvious coding makes
1395 @Bool@ just a boxed up version of @Bool#@, like this:
1396 \begin{verbatim}
1397 type Bool# = Int#
1398 data Bool = MkBool Bool#
1399 \end{verbatim}
1400
1401 Unfortunately, this doesn't correspond to what the Report says @Bool@
1402 looks like! Furthermore, we get slightly less efficient code (I
1403 think) with this coding. @gtInt@ would look like this:
1404
1405 \begin{verbatim}
1406 gtInt :: Int -> Int -> Bool
1407 gtInt x y = case x of I# x# ->
1408 case y of I# y# ->
1409 case (gtIntPrim x# y#) of
1410 b# -> MkBool b#
1411 \end{verbatim}
1412
1413 Notice that the result of the @gtIntPrim@ comparison has to be turned
1414 into an integer (here called @b#@), and returned in a @MkBool@ box.
1415
1416 The @if@ expression would compile to this:
1417 \begin{verbatim}
1418 case (gtInt x y) of
1419 MkBool b# -> case b# of { 1# -> e1; 0# -> e2 }
1420 \end{verbatim}
1421
1422 I think this code is a little less efficient than the previous code,
1423 but I'm not certain. At all events, corresponding with the Report is
1424 important. The interesting thing is that the language is expressive
1425 enough to describe more than one alternative; and that a type doesn't
1426 necessarily need to be a straightforwardly boxed version of its
1427 primitive counterpart.
1428
1429 {\em END IDLE SPECULATION BY SIMON}
1430 -}
1431
1432 boolTy :: Type
1433 boolTy = mkTyConTy boolTyCon
1434
1435 boolTyCon :: TyCon
1436 boolTyCon = pcTyCon boolTyConName
1437 (Just (CType NoSourceText Nothing
1438 (NoSourceText, fsLit "HsBool")))
1439 [] [falseDataCon, trueDataCon]
1440
1441 falseDataCon, trueDataCon :: DataCon
1442 falseDataCon = pcDataCon falseDataConName [] [] boolTyCon
1443 trueDataCon = pcDataCon trueDataConName [] [] boolTyCon
1444
1445 falseDataConId, trueDataConId :: Id
1446 falseDataConId = dataConWorkId falseDataCon
1447 trueDataConId = dataConWorkId trueDataCon
1448
1449 orderingTyCon :: TyCon
1450 orderingTyCon = pcTyCon orderingTyConName Nothing
1451 [] [ordLTDataCon, ordEQDataCon, ordGTDataCon]
1452
1453 ordLTDataCon, ordEQDataCon, ordGTDataCon :: DataCon
1454 ordLTDataCon = pcDataCon ordLTDataConName [] [] orderingTyCon
1455 ordEQDataCon = pcDataCon ordEQDataConName [] [] orderingTyCon
1456 ordGTDataCon = pcDataCon ordGTDataConName [] [] orderingTyCon
1457
1458 ordLTDataConId, ordEQDataConId, ordGTDataConId :: Id
1459 ordLTDataConId = dataConWorkId ordLTDataCon
1460 ordEQDataConId = dataConWorkId ordEQDataCon
1461 ordGTDataConId = dataConWorkId ordGTDataCon
1462
1463 {-
1464 ************************************************************************
1465 * *
1466 The List type
1467 Special syntax, deeply wired in,
1468 but otherwise an ordinary algebraic data type
1469 * *
1470 ************************************************************************
1471
1472 data [] a = [] | a : (List a)
1473 -}
1474
1475 mkListTy :: Type -> Type
1476 mkListTy ty = mkTyConApp listTyCon [ty]
1477
1478 listTyCon :: TyCon
1479 listTyCon =
1480 buildAlgTyCon listTyConName alpha_tyvar [Representational]
1481 Nothing []
1482 (mkDataTyConRhs [nilDataCon, consDataCon])
1483 False
1484 (VanillaAlgTyCon $ mkPrelTyConRepName listTyConName)
1485
1486 nilDataCon :: DataCon
1487 nilDataCon = pcDataCon nilDataConName alpha_tyvar [] listTyCon
1488
1489 consDataCon :: DataCon
1490 consDataCon = pcDataConWithFixity True {- Declared infix -}
1491 consDataConName
1492 alpha_tyvar [] alpha_tyvar
1493 [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon
1494 -- Interesting: polymorphic recursion would help here.
1495 -- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy
1496 -- gets the over-specific type (Type -> Type)
1497
1498 -- Wired-in type Maybe
1499
1500 maybeTyCon :: TyCon
1501 maybeTyCon = pcTyCon maybeTyConName Nothing alpha_tyvar
1502 [nothingDataCon, justDataCon]
1503
1504 nothingDataCon :: DataCon
1505 nothingDataCon = pcDataCon nothingDataConName alpha_tyvar [] maybeTyCon
1506
1507 justDataCon :: DataCon
1508 justDataCon = pcDataCon justDataConName alpha_tyvar [alphaTy] maybeTyCon
1509
1510 {-
1511 ** *********************************************************************
1512 * *
1513 The tuple types
1514 * *
1515 ************************************************************************
1516
1517 The tuple types are definitely magic, because they form an infinite
1518 family.
1519
1520 \begin{itemize}
1521 \item
1522 They have a special family of type constructors, of type @TyCon@
1523 These contain the tycon arity, but don't require a Unique.
1524
1525 \item
1526 They have a special family of constructors, of type
1527 @Id@. Again these contain their arity but don't need a Unique.
1528
1529 \item
1530 There should be a magic way of generating the info tables and
1531 entry code for all tuples.
1532
1533 But at the moment we just compile a Haskell source
1534 file\srcloc{lib/prelude/...} containing declarations like:
1535 \begin{verbatim}
1536 data Tuple0 = Tup0
1537 data Tuple2 a b = Tup2 a b
1538 data Tuple3 a b c = Tup3 a b c
1539 data Tuple4 a b c d = Tup4 a b c d
1540 ...
1541 \end{verbatim}
1542 The print-names associated with the magic @Id@s for tuple constructors
1543 ``just happen'' to be the same as those generated by these
1544 declarations.
1545
1546 \item
1547 The instance environment should have a magic way to know
1548 that each tuple type is an instances of classes @Eq@, @Ix@, @Ord@ and
1549 so on. \ToDo{Not implemented yet.}
1550
1551 \item
1552 There should also be a way to generate the appropriate code for each
1553 of these instances, but (like the info tables and entry code) it is
1554 done by enumeration\srcloc{lib/prelude/InTup?.hs}.
1555 \end{itemize}
1556 -}
1557
1558 -- | Make a tuple type. The list of types should /not/ include any
1559 -- RuntimeRep specifications.
1560 mkTupleTy :: Boxity -> [Type] -> Type
1561 -- Special case for *boxed* 1-tuples, which are represented by the type itself
1562 mkTupleTy Boxed [ty] = ty
1563 mkTupleTy Boxed tys = mkTyConApp (tupleTyCon Boxed (length tys)) tys
1564 mkTupleTy Unboxed tys = mkTyConApp (tupleTyCon Unboxed (length tys))
1565 (map getRuntimeRep tys ++ tys)
1566
1567 -- | Build the type of a small tuple that holds the specified type of thing
1568 mkBoxedTupleTy :: [Type] -> Type
1569 mkBoxedTupleTy tys = mkTupleTy Boxed tys
1570
1571 unitTy :: Type
1572 unitTy = mkTupleTy Boxed []
1573
1574 {- *********************************************************************
1575 * *
1576 The sum types
1577 * *
1578 ************************************************************************
1579 -}
1580
1581 mkSumTy :: [Type] -> Type
1582 mkSumTy tys = mkTyConApp (sumTyCon (length tys))
1583 (map getRuntimeRep tys ++ tys)
1584
1585 -- Promoted Booleans
1586
1587 promotedFalseDataCon, promotedTrueDataCon :: TyCon
1588 promotedTrueDataCon = promoteDataCon trueDataCon
1589 promotedFalseDataCon = promoteDataCon falseDataCon
1590
1591 -- Promoted Maybe
1592 promotedNothingDataCon, promotedJustDataCon :: TyCon
1593 promotedNothingDataCon = promoteDataCon nothingDataCon
1594 promotedJustDataCon = promoteDataCon justDataCon
1595
1596 -- Promoted Ordering
1597
1598 promotedLTDataCon
1599 , promotedEQDataCon
1600 , promotedGTDataCon
1601 :: TyCon
1602 promotedLTDataCon = promoteDataCon ordLTDataCon
1603 promotedEQDataCon = promoteDataCon ordEQDataCon
1604 promotedGTDataCon = promoteDataCon ordGTDataCon
1605
1606 -- Promoted List
1607 promotedConsDataCon, promotedNilDataCon :: TyCon
1608 promotedConsDataCon = promoteDataCon consDataCon
1609 promotedNilDataCon = promoteDataCon nilDataCon
1610
1611 -- | Make a *promoted* list.
1612 mkPromotedListTy :: Kind -- ^ of the elements of the list
1613 -> [Type] -- ^ elements
1614 -> Type
1615 mkPromotedListTy k tys
1616 = foldr cons nil tys
1617 where
1618 cons :: Type -- element
1619 -> Type -- list
1620 -> Type
1621 cons elt list = mkTyConApp promotedConsDataCon [k, elt, list]
1622
1623 nil :: Type
1624 nil = mkTyConApp promotedNilDataCon [k]
1625
1626 -- | Extract the elements of a promoted list. Panics if the type is not a
1627 -- promoted list
1628 extractPromotedList :: Type -- ^ The promoted list
1629 -> [Type]
1630 extractPromotedList tys = go tys
1631 where
1632 go list_ty
1633 | Just (tc, [_k, t, ts]) <- splitTyConApp_maybe list_ty
1634 = ASSERT( tc `hasKey` consDataConKey )
1635 t : go ts
1636
1637 | Just (tc, [_k]) <- splitTyConApp_maybe list_ty
1638 = ASSERT( tc `hasKey` nilDataConKey )
1639 []
1640
1641 | otherwise
1642 = pprPanic "extractPromotedList" (ppr tys)