Fix #13391 by checking for kind-GADTs
[ghc.git] / compiler / basicTypes / DataCon.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1998
4
5 \section[DataCon]{@DataCon@: Data Constructors}
6 -}
7
8 {-# LANGUAGE CPP, DeriveDataTypeable #-}
9
10 module DataCon (
11 -- * Main data types
12 DataCon, DataConRep(..),
13 SrcStrictness(..), SrcUnpackedness(..),
14 HsSrcBang(..), HsImplBang(..),
15 StrictnessMark(..),
16 ConTag,
17
18 -- ** Equality specs
19 EqSpec, mkEqSpec, eqSpecTyVar, eqSpecType,
20 eqSpecPair, eqSpecPreds,
21 substEqSpec, filterEqSpec,
22
23 -- ** Field labels
24 FieldLbl(..), FieldLabel, FieldLabelString,
25
26 -- ** Type construction
27 mkDataCon, buildAlgTyCon, buildSynTyCon, fIRST_TAG,
28
29 -- ** Type deconstruction
30 dataConRepType, dataConSig, dataConInstSig, dataConFullSig,
31 dataConName, dataConIdentity, dataConTag, dataConTagZ,
32 dataConTyCon, dataConOrigTyCon,
33 dataConUserType,
34 dataConUnivTyVars, dataConUnivTyVarBinders,
35 dataConExTyVars, dataConExTyVarBinders,
36 dataConAllTyVars,
37 dataConEqSpec, dataConTheta,
38 dataConStupidTheta,
39 dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
40 dataConInstOrigArgTys, dataConRepArgTys,
41 dataConFieldLabels, dataConFieldType, dataConFieldType_maybe,
42 dataConSrcBangs,
43 dataConSourceArity, dataConRepArity,
44 dataConIsInfix,
45 dataConWorkId, dataConWrapId, dataConWrapId_maybe,
46 dataConImplicitTyThings,
47 dataConRepStrictness, dataConImplBangs, dataConBoxer,
48
49 splitDataProductType_maybe,
50
51 -- ** Predicates on DataCons
52 isNullarySrcDataCon, isNullaryRepDataCon, isTupleDataCon, isUnboxedTupleCon,
53 isUnboxedSumCon,
54 isVanillaDataCon, classDataCon, dataConCannotMatch,
55 isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked,
56 specialPromotedDc, isLegacyPromotableDataCon, isLegacyPromotableTyCon,
57
58 -- ** Promotion related functions
59 promoteDataCon
60 ) where
61
62 #include "HsVersions.h"
63
64 import GhcPrelude
65
66 import {-# SOURCE #-} MkId( DataConBoxer )
67 import Type
68 import ForeignCall ( CType )
69 import Coercion
70 import Unify
71 import TyCon
72 import FieldLabel
73 import Class
74 import Name
75 import PrelNames
76 import Var
77 import Outputable
78 import ListSetOps
79 import Util
80 import BasicTypes
81 import FastString
82 import Module
83 import Binary
84 import UniqSet
85 import Unique( mkAlphaTyVarUnique )
86
87 import qualified Data.Data as Data
88 import Data.Char
89 import Data.Word
90 import Data.List( mapAccumL, find )
91
92 {-
93 Data constructor representation
94 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
95 Consider the following Haskell data type declaration
96
97 data T = T !Int ![Int]
98
99 Using the strictness annotations, GHC will represent this as
100
101 data T = T Int# [Int]
102
103 That is, the Int has been unboxed. Furthermore, the Haskell source construction
104
105 T e1 e2
106
107 is translated to
108
109 case e1 of { I# x ->
110 case e2 of { r ->
111 T x r }}
112
113 That is, the first argument is unboxed, and the second is evaluated. Finally,
114 pattern matching is translated too:
115
116 case e of { T a b -> ... }
117
118 becomes
119
120 case e of { T a' b -> let a = I# a' in ... }
121
122 To keep ourselves sane, we name the different versions of the data constructor
123 differently, as follows.
124
125
126 Note [Data Constructor Naming]
127 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
128 Each data constructor C has two, and possibly up to four, Names associated with it:
129
130 OccName Name space Name of Notes
131 ---------------------------------------------------------------------------
132 The "data con itself" C DataName DataCon In dom( GlobalRdrEnv )
133 The "worker data con" C VarName Id The worker
134 The "wrapper data con" $WC VarName Id The wrapper
135 The "newtype coercion" :CoT TcClsName TyCon
136
137 EVERY data constructor (incl for newtypes) has the former two (the
138 data con itself, and its worker. But only some data constructors have a
139 wrapper (see Note [The need for a wrapper]).
140
141 Each of these three has a distinct Unique. The "data con itself" name
142 appears in the output of the renamer, and names the Haskell-source
143 data constructor. The type checker translates it into either the wrapper Id
144 (if it exists) or worker Id (otherwise).
145
146 The data con has one or two Ids associated with it:
147
148 The "worker Id", is the actual data constructor.
149 * Every data constructor (newtype or data type) has a worker
150
151 * The worker is very like a primop, in that it has no binding.
152
153 * For a *data* type, the worker *is* the data constructor;
154 it has no unfolding
155
156 * For a *newtype*, the worker has a compulsory unfolding which
157 does a cast, e.g.
158 newtype T = MkT Int
159 The worker for MkT has unfolding
160 \\(x:Int). x `cast` sym CoT
161 Here CoT is the type constructor, witnessing the FC axiom
162 axiom CoT : T = Int
163
164 The "wrapper Id", \$WC, goes as follows
165
166 * Its type is exactly what it looks like in the source program.
167
168 * It is an ordinary function, and it gets a top-level binding
169 like any other function.
170
171 * The wrapper Id isn't generated for a data type if there is
172 nothing for the wrapper to do. That is, if its defn would be
173 \$wC = C
174
175 Note [The need for a wrapper]
176 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
177 Why might the wrapper have anything to do? Two reasons:
178
179 * Unboxing strict fields (with -funbox-strict-fields)
180 data T = MkT !(Int,Int)
181 \$wMkT :: (Int,Int) -> T
182 \$wMkT (x,y) = MkT x y
183 Notice that the worker has two fields where the wapper has
184 just one. That is, the worker has type
185 MkT :: Int -> Int -> T
186
187 * Equality constraints for GADTs
188 data T a where { MkT :: a -> T [a] }
189
190 The worker gets a type with explicit equality
191 constraints, thus:
192 MkT :: forall a b. (a=[b]) => b -> T a
193
194 The wrapper has the programmer-specified type:
195 \$wMkT :: a -> T [a]
196 \$wMkT a x = MkT [a] a [a] x
197 The third argument is a coercion
198 [a] :: [a]~[a]
199
200 INVARIANT: the dictionary constructor for a class
201 never has a wrapper.
202
203
204 A note about the stupid context
205 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
206 Data types can have a context:
207
208 data (Eq a, Ord b) => T a b = T1 a b | T2 a
209
210 and that makes the constructors have a context too
211 (notice that T2's context is "thinned"):
212
213 T1 :: (Eq a, Ord b) => a -> b -> T a b
214 T2 :: (Eq a) => a -> T a b
215
216 Furthermore, this context pops up when pattern matching
217 (though GHC hasn't implemented this, but it is in H98, and
218 I've fixed GHC so that it now does):
219
220 f (T2 x) = x
221 gets inferred type
222 f :: Eq a => T a b -> a
223
224 I say the context is "stupid" because the dictionaries passed
225 are immediately discarded -- they do nothing and have no benefit.
226 It's a flaw in the language.
227
228 Up to now [March 2002] I have put this stupid context into the
229 type of the "wrapper" constructors functions, T1 and T2, but
230 that turned out to be jolly inconvenient for generics, and
231 record update, and other functions that build values of type T
232 (because they don't have suitable dictionaries available).
233
234 So now I've taken the stupid context out. I simply deal with
235 it separately in the type checker on occurrences of a
236 constructor, either in an expression or in a pattern.
237
238 [May 2003: actually I think this decision could easily be
239 reversed now, and probably should be. Generics could be
240 disabled for types with a stupid context; record updates now
241 (H98) needs the context too; etc. It's an unforced change, so
242 I'm leaving it for now --- but it does seem odd that the
243 wrapper doesn't include the stupid context.]
244
245 [July 04] With the advent of generalised data types, it's less obvious
246 what the "stupid context" is. Consider
247 C :: forall a. Ord a => a -> a -> T (Foo a)
248 Does the C constructor in Core contain the Ord dictionary? Yes, it must:
249
250 f :: T b -> Ordering
251 f = /\b. \x:T b.
252 case x of
253 C a (d:Ord a) (p:a) (q:a) -> compare d p q
254
255 Note that (Foo a) might not be an instance of Ord.
256
257 ************************************************************************
258 * *
259 \subsection{Data constructors}
260 * *
261 ************************************************************************
262 -}
263
264 -- | A data constructor
265 --
266 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
267 -- 'ApiAnnotation.AnnClose','ApiAnnotation.AnnComma'
268
269 -- For details on above see note [Api annotations] in ApiAnnotation
270 data DataCon
271 = MkData {
272 dcName :: Name, -- This is the name of the *source data con*
273 -- (see "Note [Data Constructor Naming]" above)
274 dcUnique :: Unique, -- Cached from Name
275 dcTag :: ConTag, -- ^ Tag, used for ordering 'DataCon's
276
277 -- Running example:
278 --
279 -- *** As declared by the user
280 -- data T a where
281 -- MkT :: forall x y. (x~y,Ord x) => x -> y -> T (x,y)
282
283 -- *** As represented internally
284 -- data T a where
285 -- MkT :: forall a. forall x y. (a~(x,y),x~y,Ord x) => x -> y -> T a
286 --
287 -- The next six fields express the type of the constructor, in pieces
288 -- e.g.
289 --
290 -- dcUnivTyVars = [a]
291 -- dcExTyVars = [x,y]
292 -- dcEqSpec = [a~(x,y)]
293 -- dcOtherTheta = [x~y, Ord x]
294 -- dcOrigArgTys = [x,y]
295 -- dcRepTyCon = T
296
297 -- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
298 -- FOR THE PARENT TyCon. (This is a change (Oct05): previously, vanilla
299 -- datacons guaranteed to have the same type variables as their parent TyCon,
300 -- but that seems ugly.)
301
302 dcVanilla :: Bool, -- True <=> This is a vanilla Haskell 98 data constructor
303 -- Its type is of form
304 -- forall a1..an . t1 -> ... tm -> T a1..an
305 -- No existentials, no coercions, nothing.
306 -- That is: dcExTyVars = dcEqSpec = dcOtherTheta = []
307 -- NB 1: newtypes always have a vanilla data con
308 -- NB 2: a vanilla constructor can still be declared in GADT-style
309 -- syntax, provided its type looks like the above.
310 -- The declaration format is held in the TyCon (algTcGadtSyntax)
311
312 -- Universally-quantified type vars [a,b,c]
313 -- INVARIANT: length matches arity of the dcRepTyCon
314 -- INVARIANT: result type of data con worker is exactly (T a b c)
315 -- COROLLARY: The dcUnivTyVars are always in one-to-one correspondence with
316 -- the tyConTyVars of the parent TyCon
317 dcUnivTyVars :: [TyVarBinder],
318
319 -- Existentially-quantified type vars [x,y]
320 dcExTyVars :: [TyVarBinder],
321
322 -- INVARIANT: the UnivTyVars and ExTyVars all have distinct OccNames
323 -- Reason: less confusing, and easier to generate IfaceSyn
324
325 dcEqSpec :: [EqSpec], -- Equalities derived from the result type,
326 -- _as written by the programmer_
327
328 -- This field allows us to move conveniently between the two ways
329 -- of representing a GADT constructor's type:
330 -- MkT :: forall a b. (a ~ [b]) => b -> T a
331 -- MkT :: forall b. b -> T [b]
332 -- Each equality is of the form (a ~ ty), where 'a' is one of
333 -- the universally quantified type variables
334
335 -- The next two fields give the type context of the data constructor
336 -- (aside from the GADT constraints,
337 -- which are given by the dcExpSpec)
338 -- In GADT form, this is *exactly* what the programmer writes, even if
339 -- the context constrains only universally quantified variables
340 -- MkT :: forall a b. (a ~ b, Ord b) => a -> T a b
341 dcOtherTheta :: ThetaType, -- The other constraints in the data con's type
342 -- other than those in the dcEqSpec
343
344 dcStupidTheta :: ThetaType, -- The context of the data type declaration
345 -- data Eq a => T a = ...
346 -- or, rather, a "thinned" version thereof
347 -- "Thinned", because the Report says
348 -- to eliminate any constraints that don't mention
349 -- tyvars free in the arg types for this constructor
350 --
351 -- INVARIANT: the free tyvars of dcStupidTheta are a subset of dcUnivTyVars
352 -- Reason: dcStupidTeta is gotten by thinning the stupid theta from the tycon
353 --
354 -- "Stupid", because the dictionaries aren't used for anything.
355 -- Indeed, [as of March 02] they are no longer in the type of
356 -- the wrapper Id, because that makes it harder to use the wrap-id
357 -- to rebuild values after record selection or in generics.
358
359 dcOrigArgTys :: [Type], -- Original argument types
360 -- (before unboxing and flattening of strict fields)
361 dcOrigResTy :: Type, -- Original result type, as seen by the user
362 -- NB: for a data instance, the original user result type may
363 -- differ from the DataCon's representation TyCon. Example
364 -- data instance T [a] where MkT :: a -> T [a]
365 -- The OrigResTy is T [a], but the dcRepTyCon might be :T123
366
367 -- Now the strictness annotations and field labels of the constructor
368 dcSrcBangs :: [HsSrcBang],
369 -- See Note [Bangs on data constructor arguments]
370 --
371 -- The [HsSrcBang] as written by the programmer.
372 --
373 -- Matches 1-1 with dcOrigArgTys
374 -- Hence length = dataConSourceArity dataCon
375
376 dcFields :: [FieldLabel],
377 -- Field labels for this constructor, in the
378 -- same order as the dcOrigArgTys;
379 -- length = 0 (if not a record) or dataConSourceArity.
380
381 -- The curried worker function that corresponds to the constructor:
382 -- It doesn't have an unfolding; the code generator saturates these Ids
383 -- and allocates a real constructor when it finds one.
384 dcWorkId :: Id,
385
386 -- Constructor representation
387 dcRep :: DataConRep,
388
389 -- Cached; see Note [DataCon arities]
390 -- INVARIANT: dcRepArity == length dataConRepArgTys
391 -- INVARIANT: dcSourceArity == length dcOrigArgTys
392 dcRepArity :: Arity,
393 dcSourceArity :: Arity,
394
395 -- Result type of constructor is T t1..tn
396 dcRepTyCon :: TyCon, -- Result tycon, T
397
398 dcRepType :: Type, -- Type of the constructor
399 -- forall a x y. (a~(x,y), x~y, Ord x) =>
400 -- x -> y -> T a
401 -- (this is *not* of the constructor wrapper Id:
402 -- see Note [Data con representation] below)
403 -- Notice that the existential type parameters come *second*.
404 -- Reason: in a case expression we may find:
405 -- case (e :: T t) of
406 -- MkT x y co1 co2 (d:Ord x) (v:r) (w:F s) -> ...
407 -- It's convenient to apply the rep-type of MkT to 't', to get
408 -- forall x y. (t~(x,y), x~y, Ord x) => x -> y -> T t
409 -- and use that to check the pattern. Mind you, this is really only
410 -- used in CoreLint.
411
412
413 dcInfix :: Bool, -- True <=> declared infix
414 -- Used for Template Haskell and 'deriving' only
415 -- The actual fixity is stored elsewhere
416
417 dcPromoted :: TyCon -- The promoted TyCon
418 -- See Note [Promoted data constructors] in TyCon
419 }
420
421
422 {- Note [TyVarBinders in DataCons]
423 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
424 For the TyVarBinders in a DataCon and PatSyn:
425
426 * Each argument flag is Inferred or Specified.
427 None are Required. (A DataCon is a term-level function; see
428 Note [No Required TyBinder in terms] in TyCoRep.)
429
430 Why do we need the TyVarBinders, rather than just the TyVars? So that
431 we can construct the right type for the DataCon with its foralls
432 attributed the correct visibility. That in turn governs whether you
433 can use visible type application at a call of the data constructor.
434
435 Note [DataCon arities]
436 ~~~~~~~~~~~~~~~~~~~~~~
437 dcSourceArity does not take constraints into account,
438 but dcRepArity does. For example:
439 MkT :: Ord a => a -> T a
440 dcSourceArity = 1
441 dcRepArity = 2
442 -}
443
444 -- | Data Constructor Representation
445 data DataConRep
446 = NoDataConRep -- No wrapper
447
448 | DCR { dcr_wrap_id :: Id -- Takes src args, unboxes/flattens,
449 -- and constructs the representation
450
451 , dcr_boxer :: DataConBoxer
452
453 , dcr_arg_tys :: [Type] -- Final, representation argument types,
454 -- after unboxing and flattening,
455 -- and *including* all evidence args
456
457 , dcr_stricts :: [StrictnessMark] -- 1-1 with dcr_arg_tys
458 -- See also Note [Data-con worker strictness] in MkId.hs
459
460 , dcr_bangs :: [HsImplBang] -- The actual decisions made (including failures)
461 -- about the original arguments; 1-1 with orig_arg_tys
462 -- See Note [Bangs on data constructor arguments]
463
464 }
465 -- Algebraic data types always have a worker, and
466 -- may or may not have a wrapper, depending on whether
467 -- the wrapper does anything.
468 --
469 -- Data types have a worker with no unfolding
470 -- Newtypes just have a worker, which has a compulsory unfolding (just a cast)
471
472 -- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments
473
474 -- The wrapper (if it exists) takes dcOrigArgTys as its arguments
475 -- The worker takes dataConRepArgTys as its arguments
476 -- If the worker is absent, dataConRepArgTys is the same as dcOrigArgTys
477
478 -- The 'NoDataConRep' case is important
479 -- Not only is this efficient,
480 -- but it also ensures that the wrapper is replaced
481 -- by the worker (because it *is* the worker)
482 -- even when there are no args. E.g. in
483 -- f (:) x
484 -- the (:) *is* the worker.
485 -- This is really important in rule matching,
486 -- (We could match on the wrappers,
487 -- but that makes it less likely that rules will match
488 -- when we bring bits of unfoldings together.)
489
490 -------------------------
491
492 -- | Haskell Source Bang
493 --
494 -- Bangs on data constructor arguments as the user wrote them in the
495 -- source code.
496 --
497 -- @(HsSrcBang _ SrcUnpack SrcLazy)@ and
498 -- @(HsSrcBang _ SrcUnpack NoSrcStrict)@ (without StrictData) makes no sense, we
499 -- emit a warning (in checkValidDataCon) and treat it like
500 -- @(HsSrcBang _ NoSrcUnpack SrcLazy)@
501 data HsSrcBang =
502 HsSrcBang SourceText -- Note [Pragma source text] in BasicTypes
503 SrcUnpackedness
504 SrcStrictness
505 deriving Data.Data
506
507 -- | Haskell Implementation Bang
508 --
509 -- Bangs of data constructor arguments as generated by the compiler
510 -- after consulting HsSrcBang, flags, etc.
511 data HsImplBang
512 = HsLazy -- ^ Lazy field, or one with an unlifted type
513 | HsStrict -- ^ Strict but not unpacked field
514 | HsUnpack (Maybe Coercion)
515 -- ^ Strict and unpacked field
516 -- co :: arg-ty ~ product-ty HsBang
517 deriving Data.Data
518
519 -- | Source Strictness
520 --
521 -- What strictness annotation the user wrote
522 data SrcStrictness = SrcLazy -- ^ Lazy, ie '~'
523 | SrcStrict -- ^ Strict, ie '!'
524 | NoSrcStrict -- ^ no strictness annotation
525 deriving (Eq, Data.Data)
526
527 -- | Source Unpackedness
528 --
529 -- What unpackedness the user requested
530 data SrcUnpackedness = SrcUnpack -- ^ {-# UNPACK #-} specified
531 | SrcNoUnpack -- ^ {-# NOUNPACK #-} specified
532 | NoSrcUnpack -- ^ no unpack pragma
533 deriving (Eq, Data.Data)
534
535
536
537 -------------------------
538 -- StrictnessMark is internal only, used to indicate strictness
539 -- of the DataCon *worker* fields
540 data StrictnessMark = MarkedStrict | NotMarkedStrict
541
542 -- | An 'EqSpec' is a tyvar/type pair representing an equality made in
543 -- rejigging a GADT constructor
544 data EqSpec = EqSpec TyVar
545 Type
546
547 -- | Make an 'EqSpec'
548 mkEqSpec :: TyVar -> Type -> EqSpec
549 mkEqSpec tv ty = EqSpec tv ty
550
551 eqSpecTyVar :: EqSpec -> TyVar
552 eqSpecTyVar (EqSpec tv _) = tv
553
554 eqSpecType :: EqSpec -> Type
555 eqSpecType (EqSpec _ ty) = ty
556
557 eqSpecPair :: EqSpec -> (TyVar, Type)
558 eqSpecPair (EqSpec tv ty) = (tv, ty)
559
560 eqSpecPreds :: [EqSpec] -> ThetaType
561 eqSpecPreds spec = [ mkPrimEqPred (mkTyVarTy tv) ty
562 | EqSpec tv ty <- spec ]
563
564 -- | Substitute in an 'EqSpec'. Precondition: if the LHS of the EqSpec
565 -- is mapped in the substitution, it is mapped to a type variable, not
566 -- a full type.
567 substEqSpec :: TCvSubst -> EqSpec -> EqSpec
568 substEqSpec subst (EqSpec tv ty)
569 = EqSpec tv' (substTy subst ty)
570 where
571 tv' = getTyVar "substEqSpec" (substTyVar subst tv)
572
573 -- | Filter out any TyBinders mentioned in an EqSpec
574 filterEqSpec :: [EqSpec] -> [TyVarBinder] -> [TyVarBinder]
575 filterEqSpec eq_spec
576 = filter not_in_eq_spec
577 where
578 not_in_eq_spec bndr = let var = binderVar bndr in
579 all (not . (== var) . eqSpecTyVar) eq_spec
580
581 instance Outputable EqSpec where
582 ppr (EqSpec tv ty) = ppr (tv, ty)
583
584 {- Note [Bangs on data constructor arguments]
585 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
586 Consider
587 data T = MkT !Int {-# UNPACK #-} !Int Bool
588
589 When compiling the module, GHC will decide how to represent
590 MkT, depending on the optimisation level, and settings of
591 flags like -funbox-small-strict-fields.
592
593 Terminology:
594 * HsSrcBang: What the user wrote
595 Constructors: HsSrcBang
596
597 * HsImplBang: What GHC decided
598 Constructors: HsLazy, HsStrict, HsUnpack
599
600 * If T was defined in this module, MkT's dcSrcBangs field
601 records the [HsSrcBang] of what the user wrote; in the example
602 [ HsSrcBang _ NoSrcUnpack SrcStrict
603 , HsSrcBang _ SrcUnpack SrcStrict
604 , HsSrcBang _ NoSrcUnpack NoSrcStrictness]
605
606 * However, if T was defined in an imported module, the importing module
607 must follow the decisions made in the original module, regardless of
608 the flag settings in the importing module.
609 Also see Note [Bangs on imported data constructors] in MkId
610
611 * The dcr_bangs field of the dcRep field records the [HsImplBang]
612 If T was defined in this module, Without -O the dcr_bangs might be
613 [HsStrict, HsStrict, HsLazy]
614 With -O it might be
615 [HsStrict, HsUnpack _, HsLazy]
616 With -funbox-small-strict-fields it might be
617 [HsUnpack, HsUnpack _, HsLazy]
618 With -XStrictData it might be
619 [HsStrict, HsUnpack _, HsStrict]
620
621 Note [Data con representation]
622 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
623 The dcRepType field contains the type of the representation of a constructor
624 This may differ from the type of the constructor *Id* (built
625 by MkId.mkDataConId) for two reasons:
626 a) the constructor Id may be overloaded, but the dictionary isn't stored
627 e.g. data Eq a => T a = MkT a a
628
629 b) the constructor may store an unboxed version of a strict field.
630
631 Here's an example illustrating both:
632 data Ord a => T a = MkT Int! a
633 Here
634 T :: Ord a => Int -> a -> T a
635 but the rep type is
636 Trep :: Int# -> a -> T a
637 Actually, the unboxed part isn't implemented yet!
638
639
640
641 ************************************************************************
642 * *
643 \subsection{Instances}
644 * *
645 ************************************************************************
646 -}
647
648 instance Eq DataCon where
649 a == b = getUnique a == getUnique b
650 a /= b = getUnique a /= getUnique b
651
652 instance Uniquable DataCon where
653 getUnique = dcUnique
654
655 instance NamedThing DataCon where
656 getName = dcName
657
658 instance Outputable DataCon where
659 ppr con = ppr (dataConName con)
660
661 instance OutputableBndr DataCon where
662 pprInfixOcc con = pprInfixName (dataConName con)
663 pprPrefixOcc con = pprPrefixName (dataConName con)
664
665 instance Data.Data DataCon where
666 -- don't traverse?
667 toConstr _ = abstractConstr "DataCon"
668 gunfold _ _ = error "gunfold"
669 dataTypeOf _ = mkNoRepType "DataCon"
670
671 instance Outputable HsSrcBang where
672 ppr (HsSrcBang _ prag mark) = ppr prag <+> ppr mark
673
674 instance Outputable HsImplBang where
675 ppr HsLazy = text "Lazy"
676 ppr (HsUnpack Nothing) = text "Unpacked"
677 ppr (HsUnpack (Just co)) = text "Unpacked" <> parens (ppr co)
678 ppr HsStrict = text "StrictNotUnpacked"
679
680 instance Outputable SrcStrictness where
681 ppr SrcLazy = char '~'
682 ppr SrcStrict = char '!'
683 ppr NoSrcStrict = empty
684
685 instance Outputable SrcUnpackedness where
686 ppr SrcUnpack = text "{-# UNPACK #-}"
687 ppr SrcNoUnpack = text "{-# NOUNPACK #-}"
688 ppr NoSrcUnpack = empty
689
690 instance Outputable StrictnessMark where
691 ppr MarkedStrict = text "!"
692 ppr NotMarkedStrict = empty
693
694 instance Binary SrcStrictness where
695 put_ bh SrcLazy = putByte bh 0
696 put_ bh SrcStrict = putByte bh 1
697 put_ bh NoSrcStrict = putByte bh 2
698
699 get bh =
700 do h <- getByte bh
701 case h of
702 0 -> return SrcLazy
703 1 -> return SrcStrict
704 _ -> return NoSrcStrict
705
706 instance Binary SrcUnpackedness where
707 put_ bh SrcNoUnpack = putByte bh 0
708 put_ bh SrcUnpack = putByte bh 1
709 put_ bh NoSrcUnpack = putByte bh 2
710
711 get bh =
712 do h <- getByte bh
713 case h of
714 0 -> return SrcNoUnpack
715 1 -> return SrcUnpack
716 _ -> return NoSrcUnpack
717
718 -- | Compare strictness annotations
719 eqHsBang :: HsImplBang -> HsImplBang -> Bool
720 eqHsBang HsLazy HsLazy = True
721 eqHsBang HsStrict HsStrict = True
722 eqHsBang (HsUnpack Nothing) (HsUnpack Nothing) = True
723 eqHsBang (HsUnpack (Just c1)) (HsUnpack (Just c2))
724 = eqType (coercionType c1) (coercionType c2)
725 eqHsBang _ _ = False
726
727 isBanged :: HsImplBang -> Bool
728 isBanged (HsUnpack {}) = True
729 isBanged (HsStrict {}) = True
730 isBanged HsLazy = False
731
732 isSrcStrict :: SrcStrictness -> Bool
733 isSrcStrict SrcStrict = True
734 isSrcStrict _ = False
735
736 isSrcUnpacked :: SrcUnpackedness -> Bool
737 isSrcUnpacked SrcUnpack = True
738 isSrcUnpacked _ = False
739
740 isMarkedStrict :: StrictnessMark -> Bool
741 isMarkedStrict NotMarkedStrict = False
742 isMarkedStrict _ = True -- All others are strict
743
744 {- *********************************************************************
745 * *
746 \subsection{Construction}
747 * *
748 ********************************************************************* -}
749
750 -- | Build a new data constructor
751 mkDataCon :: Name
752 -> Bool -- ^ Is the constructor declared infix?
753 -> TyConRepName -- ^ TyConRepName for the promoted TyCon
754 -> [HsSrcBang] -- ^ Strictness/unpack annotations, from user
755 -> [FieldLabel] -- ^ Field labels for the constructor,
756 -- if it is a record, otherwise empty
757 -> [TyVarBinder] -- ^ Universals. See Note [TyVarBinders in DataCons]
758 -> [TyVarBinder] -- ^ Existentials.
759 -- (These last two must be Named and Inferred/Specified)
760 -> [EqSpec] -- ^ GADT equalities
761 -> ThetaType -- ^ Theta-type occuring before the arguments proper
762 -> [Type] -- ^ Original argument types
763 -> Type -- ^ Original result type
764 -> RuntimeRepInfo -- ^ See comments on 'TyCon.RuntimeRepInfo'
765 -> TyCon -- ^ Representation type constructor
766 -> ThetaType -- ^ The "stupid theta", context of the data
767 -- declaration e.g. @data Eq a => T a ...@
768 -> Id -- ^ Worker Id
769 -> DataConRep -- ^ Representation
770 -> DataCon
771 -- Can get the tag from the TyCon
772
773 mkDataCon name declared_infix prom_info
774 arg_stricts -- Must match orig_arg_tys 1-1
775 fields
776 univ_tvs ex_tvs
777 eq_spec theta
778 orig_arg_tys orig_res_ty rep_info rep_tycon
779 stupid_theta work_id rep
780 -- Warning: mkDataCon is not a good place to check invariants.
781 -- If the programmer writes the wrong result type in the decl, thus:
782 -- data T a where { MkT :: S }
783 -- then it's possible that the univ_tvs may hit an assertion failure
784 -- if you pull on univ_tvs. This case is checked by checkValidDataCon,
785 -- so the error is detected properly... it's just that assertions here
786 -- are a little dodgy.
787
788 = con
789 where
790 is_vanilla = null ex_tvs && null eq_spec && null theta
791 con = MkData {dcName = name, dcUnique = nameUnique name,
792 dcVanilla = is_vanilla, dcInfix = declared_infix,
793 dcUnivTyVars = univ_tvs,
794 dcExTyVars = ex_tvs,
795 dcEqSpec = eq_spec,
796 dcOtherTheta = theta,
797 dcStupidTheta = stupid_theta,
798 dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty,
799 dcRepTyCon = rep_tycon,
800 dcSrcBangs = arg_stricts,
801 dcFields = fields, dcTag = tag, dcRepType = rep_ty,
802 dcWorkId = work_id,
803 dcRep = rep,
804 dcSourceArity = length orig_arg_tys,
805 dcRepArity = length rep_arg_tys,
806 dcPromoted = promoted }
807
808 -- The 'arg_stricts' passed to mkDataCon are simply those for the
809 -- source-language arguments. We add extra ones for the
810 -- dictionary arguments right here.
811
812 tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con
813 rep_arg_tys = dataConRepArgTys con
814
815 rep_ty = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $
816 mkFunTys rep_arg_tys $
817 mkTyConApp rep_tycon (mkTyVarTys (binderVars univ_tvs))
818
819 -- See Note [Promoted data constructors] in TyCon
820 prom_tv_bndrs = [ mkNamedTyConBinder vis tv
821 | TvBndr tv vis <- filterEqSpec eq_spec univ_tvs ++ ex_tvs ]
822
823 prom_arg_bndrs = mkCleanAnonTyConBinders prom_tv_bndrs (theta ++ orig_arg_tys)
824 prom_res_kind = orig_res_ty
825 promoted = mkPromotedDataCon con name prom_info
826 (prom_tv_bndrs ++ prom_arg_bndrs)
827 prom_res_kind roles rep_info
828
829 roles = map (const Nominal) (univ_tvs ++ ex_tvs) ++
830 map (const Representational) orig_arg_tys
831
832 mkCleanAnonTyConBinders :: [TyConBinder] -> [Type] -> [TyConBinder]
833 -- Make sure that the "anonymous" tyvars don't clash in
834 -- name or unique with the universal/existential ones.
835 -- Tiresome! And unnecessary because these tyvars are never looked at
836 mkCleanAnonTyConBinders tc_bndrs tys
837 = [ mkAnonTyConBinder (mkTyVar name ty)
838 | (name, ty) <- fresh_names `zip` tys ]
839 where
840 fresh_names = freshNames (map getName (binderVars tc_bndrs))
841
842 freshNames :: [Name] -> [Name]
843 -- Make names whose Uniques and OccNames differ from
844 -- those in the 'avoid' list
845 freshNames avoids
846 = [ mkSystemName uniq occ
847 | n <- [0..]
848 , let uniq = mkAlphaTyVarUnique n
849 occ = mkTyVarOccFS (mkFastString ('x' : show n))
850
851 , not (uniq `elementOfUniqSet` avoid_uniqs)
852 , not (occ `elemOccSet` avoid_occs) ]
853
854 where
855 avoid_uniqs :: UniqSet Unique
856 avoid_uniqs = mkUniqSet (map getUnique avoids)
857
858 avoid_occs :: OccSet
859 avoid_occs = mkOccSet (map getOccName avoids)
860
861 -- | The 'Name' of the 'DataCon', giving it a unique, rooted identification
862 dataConName :: DataCon -> Name
863 dataConName = dcName
864
865 -- | The tag used for ordering 'DataCon's
866 dataConTag :: DataCon -> ConTag
867 dataConTag = dcTag
868
869 dataConTagZ :: DataCon -> ConTagZ
870 dataConTagZ con = dataConTag con - fIRST_TAG
871
872 -- | The type constructor that we are building via this data constructor
873 dataConTyCon :: DataCon -> TyCon
874 dataConTyCon = dcRepTyCon
875
876 -- | The original type constructor used in the definition of this data
877 -- constructor. In case of a data family instance, that will be the family
878 -- type constructor.
879 dataConOrigTyCon :: DataCon -> TyCon
880 dataConOrigTyCon dc
881 | Just (tc, _) <- tyConFamInst_maybe (dcRepTyCon dc) = tc
882 | otherwise = dcRepTyCon dc
883
884 -- | The representation type of the data constructor, i.e. the sort
885 -- type that will represent values of this type at runtime
886 dataConRepType :: DataCon -> Type
887 dataConRepType = dcRepType
888
889 -- | Should the 'DataCon' be presented infix?
890 dataConIsInfix :: DataCon -> Bool
891 dataConIsInfix = dcInfix
892
893 -- | The universally-quantified type variables of the constructor
894 dataConUnivTyVars :: DataCon -> [TyVar]
895 dataConUnivTyVars (MkData { dcUnivTyVars = tvbs }) = binderVars tvbs
896
897 -- | 'TyBinder's for the universally-quantified type variables
898 dataConUnivTyVarBinders :: DataCon -> [TyVarBinder]
899 dataConUnivTyVarBinders = dcUnivTyVars
900
901 -- | The existentially-quantified type variables of the constructor
902 dataConExTyVars :: DataCon -> [TyVar]
903 dataConExTyVars (MkData { dcExTyVars = tvbs }) = binderVars tvbs
904
905 -- | 'TyBinder's for the existentially-quantified type variables
906 dataConExTyVarBinders :: DataCon -> [TyVarBinder]
907 dataConExTyVarBinders = dcExTyVars
908
909 -- | Both the universal and existential type variables of the constructor
910 dataConAllTyVars :: DataCon -> [TyVar]
911 dataConAllTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
912 = binderVars (univ_tvs ++ ex_tvs)
913
914 -- | Equalities derived from the result type of the data constructor, as written
915 -- by the programmer in any GADT declaration. This includes *all* GADT-like
916 -- equalities, including those written in by hand by the programmer.
917 dataConEqSpec :: DataCon -> [EqSpec]
918 dataConEqSpec (MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })
919 = eq_spec ++
920 [ spec -- heterogeneous equality
921 | Just (tc, [_k1, _k2, ty1, ty2]) <- map splitTyConApp_maybe theta
922 , tc `hasKey` heqTyConKey
923 , spec <- case (getTyVar_maybe ty1, getTyVar_maybe ty2) of
924 (Just tv1, _) -> [mkEqSpec tv1 ty2]
925 (_, Just tv2) -> [mkEqSpec tv2 ty1]
926 _ -> []
927 ] ++
928 [ spec -- homogeneous equality
929 | Just (tc, [_k, ty1, ty2]) <- map splitTyConApp_maybe theta
930 , tc `hasKey` eqTyConKey
931 , spec <- case (getTyVar_maybe ty1, getTyVar_maybe ty2) of
932 (Just tv1, _) -> [mkEqSpec tv1 ty2]
933 (_, Just tv2) -> [mkEqSpec tv2 ty1]
934 _ -> []
935 ]
936
937
938 -- | The *full* constraints on the constructor type.
939 dataConTheta :: DataCon -> ThetaType
940 dataConTheta (MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })
941 = eqSpecPreds eq_spec ++ theta
942
943 -- | Get the Id of the 'DataCon' worker: a function that is the "actual"
944 -- constructor and has no top level binding in the program. The type may
945 -- be different from the obvious one written in the source program. Panics
946 -- if there is no such 'Id' for this 'DataCon'
947 dataConWorkId :: DataCon -> Id
948 dataConWorkId dc = dcWorkId dc
949
950 -- | Get the Id of the 'DataCon' wrapper: a function that wraps the "actual"
951 -- constructor so it has the type visible in the source program: c.f. 'dataConWorkId'.
952 -- Returns Nothing if there is no wrapper, which occurs for an algebraic data constructor
953 -- and also for a newtype (whose constructor is inlined compulsorily)
954 dataConWrapId_maybe :: DataCon -> Maybe Id
955 dataConWrapId_maybe dc = case dcRep dc of
956 NoDataConRep -> Nothing
957 DCR { dcr_wrap_id = wrap_id } -> Just wrap_id
958
959 -- | Returns an Id which looks like the Haskell-source constructor by using
960 -- the wrapper if it exists (see 'dataConWrapId_maybe') and failing over to
961 -- the worker (see 'dataConWorkId')
962 dataConWrapId :: DataCon -> Id
963 dataConWrapId dc = case dcRep dc of
964 NoDataConRep-> dcWorkId dc -- worker=wrapper
965 DCR { dcr_wrap_id = wrap_id } -> wrap_id
966
967 -- | Find all the 'Id's implicitly brought into scope by the data constructor. Currently,
968 -- the union of the 'dataConWorkId' and the 'dataConWrapId'
969 dataConImplicitTyThings :: DataCon -> [TyThing]
970 dataConImplicitTyThings (MkData { dcWorkId = work, dcRep = rep })
971 = [AnId work] ++ wrap_ids
972 where
973 wrap_ids = case rep of
974 NoDataConRep -> []
975 DCR { dcr_wrap_id = wrap } -> [AnId wrap]
976
977 -- | The labels for the fields of this particular 'DataCon'
978 dataConFieldLabels :: DataCon -> [FieldLabel]
979 dataConFieldLabels = dcFields
980
981 -- | Extract the type for any given labelled field of the 'DataCon'
982 dataConFieldType :: DataCon -> FieldLabelString -> Type
983 dataConFieldType con label = case dataConFieldType_maybe con label of
984 Just (_, ty) -> ty
985 Nothing -> pprPanic "dataConFieldType" (ppr con <+> ppr label)
986
987 -- | Extract the label and type for any given labelled field of the
988 -- 'DataCon', or return 'Nothing' if the field does not belong to it
989 dataConFieldType_maybe :: DataCon -> FieldLabelString
990 -> Maybe (FieldLabel, Type)
991 dataConFieldType_maybe con label
992 = find ((== label) . flLabel . fst) (dcFields con `zip` dcOrigArgTys con)
993
994 -- | Strictness/unpack annotations, from user; or, for imported
995 -- DataCons, from the interface file
996 -- The list is in one-to-one correspondence with the arity of the 'DataCon'
997
998 dataConSrcBangs :: DataCon -> [HsSrcBang]
999 dataConSrcBangs = dcSrcBangs
1000
1001 -- | Source-level arity of the data constructor
1002 dataConSourceArity :: DataCon -> Arity
1003 dataConSourceArity (MkData { dcSourceArity = arity }) = arity
1004
1005 -- | Gives the number of actual fields in the /representation/ of the
1006 -- data constructor. This may be more than appear in the source code;
1007 -- the extra ones are the existentially quantified dictionaries
1008 dataConRepArity :: DataCon -> Arity
1009 dataConRepArity (MkData { dcRepArity = arity }) = arity
1010
1011 -- | Return whether there are any argument types for this 'DataCon's original source type
1012 -- See Note [DataCon arities]
1013 isNullarySrcDataCon :: DataCon -> Bool
1014 isNullarySrcDataCon dc = dataConSourceArity dc == 0
1015
1016 -- | Return whether there are any argument types for this 'DataCon's runtime representation type
1017 -- See Note [DataCon arities]
1018 isNullaryRepDataCon :: DataCon -> Bool
1019 isNullaryRepDataCon dc = dataConRepArity dc == 0
1020
1021 dataConRepStrictness :: DataCon -> [StrictnessMark]
1022 -- ^ Give the demands on the arguments of a
1023 -- Core constructor application (Con dc args)
1024 dataConRepStrictness dc = case dcRep dc of
1025 NoDataConRep -> [NotMarkedStrict | _ <- dataConRepArgTys dc]
1026 DCR { dcr_stricts = strs } -> strs
1027
1028 dataConImplBangs :: DataCon -> [HsImplBang]
1029 -- The implementation decisions about the strictness/unpack of each
1030 -- source program argument to the data constructor
1031 dataConImplBangs dc
1032 = case dcRep dc of
1033 NoDataConRep -> replicate (dcSourceArity dc) HsLazy
1034 DCR { dcr_bangs = bangs } -> bangs
1035
1036 dataConBoxer :: DataCon -> Maybe DataConBoxer
1037 dataConBoxer (MkData { dcRep = DCR { dcr_boxer = boxer } }) = Just boxer
1038 dataConBoxer _ = Nothing
1039
1040 -- | The \"signature\" of the 'DataCon' returns, in order:
1041 --
1042 -- 1) The result of 'dataConAllTyVars',
1043 --
1044 -- 2) All the 'ThetaType's relating to the 'DataCon' (coercion, dictionary, implicit
1045 -- parameter - whatever)
1046 --
1047 -- 3) The type arguments to the constructor
1048 --
1049 -- 4) The /original/ result type of the 'DataCon'
1050 dataConSig :: DataCon -> ([TyVar], ThetaType, [Type], Type)
1051 dataConSig con@(MkData {dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
1052 = (dataConAllTyVars con, dataConTheta con, arg_tys, res_ty)
1053
1054 dataConInstSig
1055 :: DataCon
1056 -> [Type] -- Instantiate the *universal* tyvars with these types
1057 -> ([TyVar], ThetaType, [Type]) -- Return instantiated existentials
1058 -- theta and arg tys
1059 -- ^ Instantiate the universal tyvars of a data con,
1060 -- returning the instantiated existentials, constraints, and args
1061 dataConInstSig (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs
1062 , dcEqSpec = eq_spec, dcOtherTheta = theta
1063 , dcOrigArgTys = arg_tys })
1064 univ_tys
1065 = ( ex_tvs'
1066 , substTheta subst (eqSpecPreds eq_spec ++ theta)
1067 , substTys subst arg_tys)
1068 where
1069 univ_subst = zipTvSubst (binderVars univ_tvs) univ_tys
1070 (subst, ex_tvs') = mapAccumL Type.substTyVarBndr univ_subst $
1071 binderVars ex_tvs
1072
1073
1074 -- | The \"full signature\" of the 'DataCon' returns, in order:
1075 --
1076 -- 1) The result of 'dataConUnivTyVars'
1077 --
1078 -- 2) The result of 'dataConExTyVars'
1079 --
1080 -- 3) The GADT equalities
1081 --
1082 -- 4) The result of 'dataConDictTheta'
1083 --
1084 -- 5) The original argument types to the 'DataCon' (i.e. before
1085 -- any change of the representation of the type)
1086 --
1087 -- 6) The original result type of the 'DataCon'
1088 dataConFullSig :: DataCon
1089 -> ([TyVar], [TyVar], [EqSpec], ThetaType, [Type], Type)
1090 dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
1091 dcEqSpec = eq_spec, dcOtherTheta = theta,
1092 dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
1093 = (binderVars univ_tvs, binderVars ex_tvs, eq_spec, theta, arg_tys, res_ty)
1094
1095 dataConOrigResTy :: DataCon -> Type
1096 dataConOrigResTy dc = dcOrigResTy dc
1097
1098 -- | The \"stupid theta\" of the 'DataCon', such as @data Eq a@ in:
1099 --
1100 -- > data Eq a => T a = ...
1101 dataConStupidTheta :: DataCon -> ThetaType
1102 dataConStupidTheta dc = dcStupidTheta dc
1103
1104 dataConUserType :: DataCon -> Type
1105 -- ^ The user-declared type of the data constructor
1106 -- in the nice-to-read form:
1107 --
1108 -- > T :: forall a b. a -> b -> T [a]
1109 --
1110 -- rather than:
1111 --
1112 -- > T :: forall a c. forall b. (c~[a]) => a -> b -> T c
1113 --
1114 -- NB: If the constructor is part of a data instance, the result type
1115 -- mentions the family tycon, not the internal one.
1116 dataConUserType (MkData { dcUnivTyVars = univ_tvs,
1117 dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
1118 dcOtherTheta = theta, dcOrigArgTys = arg_tys,
1119 dcOrigResTy = res_ty })
1120 = mkForAllTys (filterEqSpec eq_spec univ_tvs) $
1121 mkForAllTys ex_tvs $
1122 mkFunTys theta $
1123 mkFunTys arg_tys $
1124 res_ty
1125
1126 -- | Finds the instantiated types of the arguments required to construct a 'DataCon' representation
1127 -- NB: these INCLUDE any dictionary args
1128 -- but EXCLUDE the data-declaration context, which is discarded
1129 -- It's all post-flattening etc; this is a representation type
1130 dataConInstArgTys :: DataCon -- ^ A datacon with no existentials or equality constraints
1131 -- However, it can have a dcTheta (notably it can be a
1132 -- class dictionary, with superclasses)
1133 -> [Type] -- ^ Instantiated at these types
1134 -> [Type]
1135 dataConInstArgTys dc@(MkData {dcUnivTyVars = univ_tvs,
1136 dcExTyVars = ex_tvs}) inst_tys
1137 = ASSERT2( univ_tvs `equalLength` inst_tys
1138 , text "dataConInstArgTys" <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
1139 ASSERT2( null ex_tvs, ppr dc )
1140 map (substTyWith (binderVars univ_tvs) inst_tys) (dataConRepArgTys dc)
1141
1142 -- | Returns just the instantiated /value/ argument types of a 'DataCon',
1143 -- (excluding dictionary args)
1144 dataConInstOrigArgTys
1145 :: DataCon -- Works for any DataCon
1146 -> [Type] -- Includes existential tyvar args, but NOT
1147 -- equality constraints or dicts
1148 -> [Type]
1149 -- For vanilla datacons, it's all quite straightforward
1150 -- But for the call in MatchCon, we really do want just the value args
1151 dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
1152 dcUnivTyVars = univ_tvs,
1153 dcExTyVars = ex_tvs}) inst_tys
1154 = ASSERT2( tyvars `equalLength` inst_tys
1155 , text "dataConInstOrigArgTys" <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
1156 map (substTyWith tyvars inst_tys) arg_tys
1157 where
1158 tyvars = binderVars (univ_tvs ++ ex_tvs)
1159
1160 -- | Returns the argument types of the wrapper, excluding all dictionary arguments
1161 -- and without substituting for any type variables
1162 dataConOrigArgTys :: DataCon -> [Type]
1163 dataConOrigArgTys dc = dcOrigArgTys dc
1164
1165 -- | Returns the arg types of the worker, including *all*
1166 -- evidence, after any flattening has been done and without substituting for
1167 -- any type variables
1168 dataConRepArgTys :: DataCon -> [Type]
1169 dataConRepArgTys (MkData { dcRep = rep
1170 , dcEqSpec = eq_spec
1171 , dcOtherTheta = theta
1172 , dcOrigArgTys = orig_arg_tys })
1173 = case rep of
1174 NoDataConRep -> ASSERT( null eq_spec ) theta ++ orig_arg_tys
1175 DCR { dcr_arg_tys = arg_tys } -> arg_tys
1176
1177 -- | The string @package:module.name@ identifying a constructor, which is attached
1178 -- to its info table and used by the GHCi debugger and the heap profiler
1179 dataConIdentity :: DataCon -> [Word8]
1180 -- We want this string to be UTF-8, so we get the bytes directly from the FastStrings.
1181 dataConIdentity dc = bytesFS (unitIdFS (moduleUnitId mod)) ++
1182 fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++
1183 fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
1184 where name = dataConName dc
1185 mod = ASSERT( isExternalName name ) nameModule name
1186
1187 isTupleDataCon :: DataCon -> Bool
1188 isTupleDataCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc
1189
1190 isUnboxedTupleCon :: DataCon -> Bool
1191 isUnboxedTupleCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc
1192
1193 isUnboxedSumCon :: DataCon -> Bool
1194 isUnboxedSumCon (MkData {dcRepTyCon = tc}) = isUnboxedSumTyCon tc
1195
1196 -- | Vanilla 'DataCon's are those that are nice boring Haskell 98 constructors
1197 isVanillaDataCon :: DataCon -> Bool
1198 isVanillaDataCon dc = dcVanilla dc
1199
1200 -- | Should this DataCon be allowed in a type even without -XDataKinds?
1201 -- Currently, only Lifted & Unlifted
1202 specialPromotedDc :: DataCon -> Bool
1203 specialPromotedDc = isKindTyCon . dataConTyCon
1204
1205 -- | Was this datacon promotable before GHC 8.0? That is, is it promotable
1206 -- without -XTypeInType
1207 isLegacyPromotableDataCon :: DataCon -> Bool
1208 isLegacyPromotableDataCon dc
1209 = null (dataConEqSpec dc) -- no GADTs
1210 && null (dataConTheta dc) -- no context
1211 && not (isFamInstTyCon (dataConTyCon dc)) -- no data instance constructors
1212 && uniqSetAll isLegacyPromotableTyCon (tyConsOfType (dataConUserType dc))
1213
1214 -- | Was this tycon promotable before GHC 8.0? That is, is it promotable
1215 -- without -XTypeInType
1216 isLegacyPromotableTyCon :: TyCon -> Bool
1217 isLegacyPromotableTyCon tc
1218 = isVanillaAlgTyCon tc ||
1219 -- This returns True more often than it should, but it's quite painful
1220 -- to make this fully accurate. And no harm is caused; we just don't
1221 -- require -XTypeInType every time we need to. (We'll always require
1222 -- -XDataKinds, though, so there's no standards-compliance issue.)
1223 isFunTyCon tc || isKindTyCon tc
1224
1225 classDataCon :: Class -> DataCon
1226 classDataCon clas = case tyConDataCons (classTyCon clas) of
1227 (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
1228 [] -> panic "classDataCon"
1229
1230 dataConCannotMatch :: [Type] -> DataCon -> Bool
1231 -- Returns True iff the data con *definitely cannot* match a
1232 -- scrutinee of type (T tys)
1233 -- where T is the dcRepTyCon for the data con
1234 dataConCannotMatch tys con
1235 | null inst_theta = False -- Common
1236 | all isTyVarTy tys = False -- Also common
1237 | otherwise = typesCantMatch (concatMap predEqs inst_theta)
1238 where
1239 (_, inst_theta, _) = dataConInstSig con tys
1240
1241 -- TODO: could gather equalities from superclasses too
1242 predEqs pred = case classifyPredType pred of
1243 EqPred NomEq ty1 ty2 -> [(ty1, ty2)]
1244 ClassPred eq [_, ty1, ty2]
1245 | eq `hasKey` eqTyConKey -> [(ty1, ty2)]
1246 _ -> []
1247
1248 {-
1249 %************************************************************************
1250 %* *
1251 Promoting of data types to the kind level
1252 * *
1253 ************************************************************************
1254
1255 -}
1256
1257 promoteDataCon :: DataCon -> TyCon
1258 promoteDataCon (MkData { dcPromoted = tc }) = tc
1259
1260 {-
1261 ************************************************************************
1262 * *
1263 \subsection{Splitting products}
1264 * *
1265 ************************************************************************
1266 -}
1267
1268 -- | Extract the type constructor, type argument, data constructor and it's
1269 -- /representation/ argument types from a type if it is a product type.
1270 --
1271 -- Precisely, we return @Just@ for any type that is all of:
1272 --
1273 -- * Concrete (i.e. constructors visible)
1274 --
1275 -- * Single-constructor
1276 --
1277 -- * Not existentially quantified
1278 --
1279 -- Whether the type is a @data@ type or a @newtype@
1280 splitDataProductType_maybe
1281 :: Type -- ^ A product type, perhaps
1282 -> Maybe (TyCon, -- The type constructor
1283 [Type], -- Type args of the tycon
1284 DataCon, -- The data constructor
1285 [Type]) -- Its /representation/ arg types
1286
1287 -- Rejecting existentials is conservative. Maybe some things
1288 -- could be made to work with them, but I'm not going to sweat
1289 -- it through till someone finds it's important.
1290
1291 splitDataProductType_maybe ty
1292 | Just (tycon, ty_args) <- splitTyConApp_maybe ty
1293 , Just con <- isDataProductTyCon_maybe tycon
1294 = Just (tycon, ty_args, con, dataConInstArgTys con ty_args)
1295 | otherwise
1296 = Nothing
1297
1298 {-
1299 ************************************************************************
1300 * *
1301 Building an algebraic data type
1302 * *
1303 ************************************************************************
1304
1305 buildAlgTyCon is here because it is called from TysWiredIn, which can
1306 depend on this module, but not on BuildTyCl.
1307 -}
1308
1309 buildAlgTyCon :: Name
1310 -> [TyVar] -- ^ Kind variables and type variables
1311 -> [Role]
1312 -> Maybe CType
1313 -> ThetaType -- ^ Stupid theta
1314 -> AlgTyConRhs
1315 -> Bool -- ^ True <=> was declared in GADT syntax
1316 -> AlgTyConFlav
1317 -> TyCon
1318
1319 buildAlgTyCon tc_name ktvs roles cType stupid_theta rhs
1320 gadt_syn parent
1321 = mkAlgTyCon tc_name binders liftedTypeKind roles cType stupid_theta
1322 rhs parent gadt_syn
1323 where
1324 binders = mkTyConBindersPreferAnon ktvs liftedTypeKind
1325
1326 buildSynTyCon :: Name -> [TyConBinder] -> Kind -- ^ /result/ kind
1327 -> [Role] -> Type -> TyCon
1328 buildSynTyCon name binders res_kind roles rhs
1329 = mkSynonymTyCon name binders res_kind roles rhs is_tau is_fam_free
1330 where
1331 is_tau = isTauTy rhs
1332 is_fam_free = isFamFreeTy rhs