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