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