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