2ab29aae95b6853692d53c07496a4df22c9eb52b
[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, dataConUnivTyVarBinders,
34 dataConExTyVars, dataConExTyVarBinders,
35 dataConAllTyVars,
36 dataConEqSpec, dataConTheta,
37 dataConStupidTheta,
38 dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
39 dataConInstOrigArgTys, dataConRepArgTys,
40 dataConFieldLabels, dataConFieldType,
41 dataConSrcBangs,
42 dataConSourceArity, dataConRepArity,
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 isUnboxedSumCon,
53 isVanillaDataCon, classDataCon, dataConCannotMatch,
54 isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked,
55 specialPromotedDc, isLegacyPromotableDataCon, isLegacyPromotableTyCon,
56
57 -- ** Promotion related functions
58 promoteDataCon
59 ) where
60
61 #include "HsVersions.h"
62
63 import {-# SOURCE #-} MkId( DataConBoxer )
64 import Type
65 import ForeignCall ( CType )
66 import Coercion
67 import Unify
68 import TyCon
69 import FieldLabel
70 import Class
71 import Name
72 import PrelNames
73 import Var
74 import Outputable
75 import ListSetOps
76 import Util
77 import BasicTypes
78 import FastString
79 import Module
80 import Binary
81 import UniqSet
82 import UniqFM
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 evasily 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
386 -- dcRepArity == length dataConRepArgTys
387 dcRepArity :: Arity,
388 -- dcSourceArity == length dcOrigArgTys
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
432 data DataConRep
433 = NoDataConRep -- No wrapper
434
435 | DCR { dcr_wrap_id :: Id -- Takes src args, unboxes/flattens,
436 -- and constructs the representation
437
438 , dcr_boxer :: DataConBoxer
439
440 , dcr_arg_tys :: [Type] -- Final, representation argument types,
441 -- after unboxing and flattening,
442 -- and *including* all evidence args
443
444 , dcr_stricts :: [StrictnessMark] -- 1-1 with dcr_arg_tys
445 -- See also Note [Data-con worker strictness] in MkId.hs
446
447 , dcr_bangs :: [HsImplBang] -- The actual decisions made (including failures)
448 -- about the original arguments; 1-1 with orig_arg_tys
449 -- See Note [Bangs on data constructor arguments]
450
451 }
452 -- Algebraic data types always have a worker, and
453 -- may or may not have a wrapper, depending on whether
454 -- the wrapper does anything.
455 --
456 -- Data types have a worker with no unfolding
457 -- Newtypes just have a worker, which has a compulsory unfolding (just a cast)
458
459 -- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments
460
461 -- The wrapper (if it exists) takes dcOrigArgTys as its arguments
462 -- The worker takes dataConRepArgTys as its arguments
463 -- If the worker is absent, dataConRepArgTys is the same as dcOrigArgTys
464
465 -- The 'NoDataConRep' case is important
466 -- Not only is this efficient,
467 -- but it also ensures that the wrapper is replaced
468 -- by the worker (because it *is* the worker)
469 -- even when there are no args. E.g. in
470 -- f (:) x
471 -- the (:) *is* the worker.
472 -- This is really important in rule matching,
473 -- (We could match on the wrappers,
474 -- but that makes it less likely that rules will match
475 -- when we bring bits of unfoldings together.)
476
477 -------------------------
478
479 -- | Bangs on data constructor arguments as the user wrote them in the
480 -- source code.
481 --
482 -- (HsSrcBang _ SrcUnpack SrcLazy) and
483 -- (HsSrcBang _ SrcUnpack NoSrcStrict) (without StrictData) makes no sense, we
484 -- emit a warning (in checkValidDataCon) and treat it like
485 -- (HsSrcBang _ NoSrcUnpack SrcLazy)
486 data HsSrcBang =
487 HsSrcBang (Maybe SourceText) -- Note [Pragma source text] in BasicTypes
488 SrcUnpackedness
489 SrcStrictness
490 deriving Data.Data
491
492 -- | Bangs of data constructor arguments as generated by the compiler
493 -- after consulting HsSrcBang, flags, etc.
494 data HsImplBang
495 = HsLazy -- ^ Lazy field
496 | HsStrict -- ^ Strict but not unpacked field
497 | HsUnpack (Maybe Coercion)
498 -- ^ Strict and unpacked field
499 -- co :: arg-ty ~ product-ty HsBang
500 deriving Data.Data
501
502 -- | What strictness annotation the user wrote
503 data SrcStrictness = SrcLazy -- ^ Lazy, ie '~'
504 | SrcStrict -- ^ Strict, ie '!'
505 | NoSrcStrict -- ^ no strictness annotation
506 deriving (Eq, Data.Data)
507
508 -- | What unpackedness the user requested
509 data SrcUnpackedness = SrcUnpack -- ^ {-# UNPACK #-} specified
510 | SrcNoUnpack -- ^ {-# NOUNPACK #-} specified
511 | NoSrcUnpack -- ^ no unpack pragma
512 deriving (Eq, Data.Data)
513
514
515
516 -------------------------
517 -- StrictnessMark is internal only, used to indicate strictness
518 -- of the DataCon *worker* fields
519 data StrictnessMark = MarkedStrict | NotMarkedStrict
520
521 -- | An 'EqSpec' is a tyvar/type pair representing an equality made in
522 -- rejigging a GADT constructor
523 data EqSpec = EqSpec TyVar
524 Type
525
526 -- | Make an 'EqSpec'
527 mkEqSpec :: TyVar -> Type -> EqSpec
528 mkEqSpec tv ty = EqSpec tv ty
529
530 eqSpecTyVar :: EqSpec -> TyVar
531 eqSpecTyVar (EqSpec tv _) = tv
532
533 eqSpecType :: EqSpec -> Type
534 eqSpecType (EqSpec _ ty) = ty
535
536 eqSpecPair :: EqSpec -> (TyVar, Type)
537 eqSpecPair (EqSpec tv ty) = (tv, ty)
538
539 eqSpecPreds :: [EqSpec] -> ThetaType
540 eqSpecPreds spec = [ mkPrimEqPred (mkTyVarTy tv) ty
541 | EqSpec tv ty <- spec ]
542
543 -- | Substitute in an 'EqSpec'. Precondition: if the LHS of the EqSpec
544 -- is mapped in the substitution, it is mapped to a type variable, not
545 -- a full type.
546 substEqSpec :: TCvSubst -> EqSpec -> EqSpec
547 substEqSpec subst (EqSpec tv ty)
548 = EqSpec tv' (substTy subst ty)
549 where
550 tv' = getTyVar "substEqSpec" (substTyVar subst tv)
551
552 -- | Filter out any TyBinders mentioned in an EqSpec
553 filterEqSpec :: [EqSpec] -> [TyVarBinder] -> [TyVarBinder]
554 filterEqSpec eq_spec
555 = filter not_in_eq_spec
556 where
557 not_in_eq_spec bndr = let var = binderVar bndr in
558 all (not . (== var) . eqSpecTyVar) eq_spec
559
560 instance Outputable EqSpec where
561 ppr (EqSpec tv ty) = ppr (tv, ty)
562
563 {- Note [Bangs on data constructor arguments]
564 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
565 Consider
566 data T = MkT !Int {-# UNPACK #-} !Int Bool
567
568 When compiling the module, GHC will decide how to represent
569 MkT, depending on the optimisation level, and settings of
570 flags like -funbox-small-strict-fields.
571
572 Terminology:
573 * HsSrcBang: What the user wrote
574 Constructors: HsSrcBang
575
576 * HsImplBang: What GHC decided
577 Constructors: HsLazy, HsStrict, HsUnpack
578
579 * If T was defined in this module, MkT's dcSrcBangs field
580 records the [HsSrcBang] of what the user wrote; in the example
581 [ HsSrcBang _ NoSrcUnpack SrcStrict
582 , HsSrcBang _ SrcUnpack SrcStrict
583 , HsSrcBang _ NoSrcUnpack NoSrcStrictness]
584
585 * However, if T was defined in an imported module, the importing module
586 must follow the decisions made in the original module, regardless of
587 the flag settings in the importing module.
588 Also see Note [Bangs on imported data constructors] in MkId
589
590 * The dcr_bangs field of the dcRep field records the [HsImplBang]
591 If T was defined in this module, Without -O the dcr_bangs might be
592 [HsStrict, HsStrict, HsLazy]
593 With -O it might be
594 [HsStrict, HsUnpack _, HsLazy]
595 With -funbox-small-strict-fields it might be
596 [HsUnpack, HsUnpack _, HsLazy]
597 With -XStrictData it might be
598 [HsStrict, HsUnpack _, HsStrict]
599
600 Note [Data con representation]
601 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
602 The dcRepType field contains the type of the representation of a constructor
603 This may differ from the type of the constructor *Id* (built
604 by MkId.mkDataConId) for two reasons:
605 a) the constructor Id may be overloaded, but the dictionary isn't stored
606 e.g. data Eq a => T a = MkT a a
607
608 b) the constructor may store an unboxed version of a strict field.
609
610 Here's an example illustrating both:
611 data Ord a => T a = MkT Int! a
612 Here
613 T :: Ord a => Int -> a -> T a
614 but the rep type is
615 Trep :: Int# -> a -> T a
616 Actually, the unboxed part isn't implemented yet!
617
618
619
620 ************************************************************************
621 * *
622 \subsection{Instances}
623 * *
624 ************************************************************************
625 -}
626
627 instance Eq DataCon where
628 a == b = getUnique a == getUnique b
629 a /= b = getUnique a /= getUnique b
630
631 instance Uniquable DataCon where
632 getUnique = dcUnique
633
634 instance NamedThing DataCon where
635 getName = dcName
636
637 instance Outputable DataCon where
638 ppr con = ppr (dataConName con)
639
640 instance OutputableBndr DataCon where
641 pprInfixOcc con = pprInfixName (dataConName con)
642 pprPrefixOcc con = pprPrefixName (dataConName con)
643
644 instance Data.Data DataCon where
645 -- don't traverse?
646 toConstr _ = abstractConstr "DataCon"
647 gunfold _ _ = error "gunfold"
648 dataTypeOf _ = mkNoRepType "DataCon"
649
650 instance Outputable HsSrcBang where
651 ppr (HsSrcBang _ prag mark) = ppr prag <+> ppr mark
652
653 instance Outputable HsImplBang where
654 ppr HsLazy = text "Lazy"
655 ppr (HsUnpack Nothing) = text "Unpacked"
656 ppr (HsUnpack (Just co)) = text "Unpacked" <> parens (ppr co)
657 ppr HsStrict = text "StrictNotUnpacked"
658
659 instance Outputable SrcStrictness where
660 ppr SrcLazy = char '~'
661 ppr SrcStrict = char '!'
662 ppr NoSrcStrict = empty
663
664 instance Outputable SrcUnpackedness where
665 ppr SrcUnpack = text "{-# UNPACK #-}"
666 ppr SrcNoUnpack = text "{-# NOUNPACK #-}"
667 ppr NoSrcUnpack = empty
668
669 instance Outputable StrictnessMark where
670 ppr MarkedStrict = text "!"
671 ppr NotMarkedStrict = empty
672
673 instance Binary SrcStrictness where
674 put_ bh SrcLazy = putByte bh 0
675 put_ bh SrcStrict = putByte bh 1
676 put_ bh NoSrcStrict = putByte bh 2
677
678 get bh =
679 do h <- getByte bh
680 case h of
681 0 -> return SrcLazy
682 1 -> return SrcLazy
683 _ -> return NoSrcStrict
684
685 instance Binary SrcUnpackedness where
686 put_ bh SrcNoUnpack = putByte bh 0
687 put_ bh SrcUnpack = putByte bh 1
688 put_ bh NoSrcUnpack = putByte bh 2
689
690 get bh =
691 do h <- getByte bh
692 case h of
693 0 -> return SrcNoUnpack
694 1 -> return SrcUnpack
695 _ -> return NoSrcUnpack
696
697 -- | Compare strictness annotations
698 eqHsBang :: HsImplBang -> HsImplBang -> Bool
699 eqHsBang HsLazy HsLazy = True
700 eqHsBang HsStrict HsStrict = True
701 eqHsBang (HsUnpack Nothing) (HsUnpack Nothing) = True
702 eqHsBang (HsUnpack (Just c1)) (HsUnpack (Just c2))
703 = eqType (coercionType c1) (coercionType c2)
704 eqHsBang _ _ = False
705
706 isBanged :: HsImplBang -> Bool
707 isBanged (HsUnpack {}) = True
708 isBanged (HsStrict {}) = True
709 isBanged HsLazy = False
710
711 isSrcStrict :: SrcStrictness -> Bool
712 isSrcStrict SrcStrict = True
713 isSrcStrict _ = False
714
715 isSrcUnpacked :: SrcUnpackedness -> Bool
716 isSrcUnpacked SrcUnpack = True
717 isSrcUnpacked _ = False
718
719 isMarkedStrict :: StrictnessMark -> Bool
720 isMarkedStrict NotMarkedStrict = False
721 isMarkedStrict _ = True -- All others are strict
722
723 {- *********************************************************************
724 * *
725 \subsection{Construction}
726 * *
727 ********************************************************************* -}
728
729 -- | Build a new data constructor
730 mkDataCon :: Name
731 -> Bool -- ^ Is the constructor declared infix?
732 -> TyConRepName -- ^ TyConRepName for the promoted TyCon
733 -> [HsSrcBang] -- ^ Strictness/unpack annotations, from user
734 -> [FieldLabel] -- ^ Field labels for the constructor,
735 -- if it is a record, otherwise empty
736 -> [TyVarBinder] -- ^ Universals. See Note [TyVarBinders in DataCons]
737 -> [TyVarBinder] -- ^ Existentials.
738 -- (These last two must be Named and Inferred/Specified)
739 -> [EqSpec] -- ^ GADT equalities
740 -> ThetaType -- ^ Theta-type occuring before the arguments proper
741 -> [Type] -- ^ Original argument types
742 -> Type -- ^ Original result type
743 -> RuntimeRepInfo -- ^ See comments on 'TyCon.RuntimeRepInfo'
744 -> TyCon -- ^ Representation type constructor
745 -> ThetaType -- ^ The "stupid theta", context of the data
746 -- declaration e.g. @data Eq a => T a ...@
747 -> Id -- ^ Worker Id
748 -> DataConRep -- ^ Representation
749 -> DataCon
750 -- Can get the tag from the TyCon
751
752 mkDataCon name declared_infix prom_info
753 arg_stricts -- Must match orig_arg_tys 1-1
754 fields
755 univ_tvs ex_tvs
756 eq_spec theta
757 orig_arg_tys orig_res_ty rep_info rep_tycon
758 stupid_theta work_id rep
759 -- Warning: mkDataCon is not a good place to check invariants.
760 -- If the programmer writes the wrong result type in the decl, thus:
761 -- data T a where { MkT :: S }
762 -- then it's possible that the univ_tvs may hit an assertion failure
763 -- if you pull on univ_tvs. This case is checked by checkValidDataCon,
764 -- so the error is detected properly... it's just that asaertions here
765 -- are a little dodgy.
766
767 = con
768 where
769 is_vanilla = null ex_tvs && null eq_spec && null theta
770 con = MkData {dcName = name, dcUnique = nameUnique name,
771 dcVanilla = is_vanilla, dcInfix = declared_infix,
772 dcUnivTyVars = univ_tvs,
773 dcExTyVars = ex_tvs,
774 dcEqSpec = eq_spec,
775 dcOtherTheta = theta,
776 dcStupidTheta = stupid_theta,
777 dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty,
778 dcRepTyCon = rep_tycon,
779 dcSrcBangs = arg_stricts,
780 dcFields = fields, dcTag = tag, dcRepType = rep_ty,
781 dcWorkId = work_id,
782 dcRep = rep,
783 dcSourceArity = length orig_arg_tys,
784 dcRepArity = length rep_arg_tys,
785 dcPromoted = promoted }
786
787 -- The 'arg_stricts' passed to mkDataCon are simply those for the
788 -- source-language arguments. We add extra ones for the
789 -- dictionary arguments right here.
790
791 tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con
792 rep_arg_tys = dataConRepArgTys con
793
794 rep_ty = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $
795 mkFunTys rep_arg_tys $
796 mkTyConApp rep_tycon (mkTyVarTys (binderVars univ_tvs))
797
798 -- See Note [Promoted data constructors] in TyCon
799 prom_tv_bndrs = [ mkNamedTyConBinder vis tv
800 | TvBndr tv vis <- filterEqSpec eq_spec univ_tvs ++ ex_tvs ]
801
802 prom_arg_bndrs = mkCleanAnonTyConBinders prom_tv_bndrs (theta ++ orig_arg_tys)
803 prom_res_kind = orig_res_ty
804 promoted = mkPromotedDataCon con name prom_info
805 (prom_tv_bndrs ++ prom_arg_bndrs)
806 prom_res_kind roles rep_info
807
808 roles = map (const Nominal) (univ_tvs ++ ex_tvs) ++
809 map (const Representational) orig_arg_tys
810
811 mkCleanAnonTyConBinders :: [TyConBinder] -> [Type] -> [TyConBinder]
812 -- Make sure that the "anonymous" tyvars don't clash in
813 -- name or unique with the universal/existential ones.
814 -- Tiresome! And unnecessary because these tyvars are never looked at
815 mkCleanAnonTyConBinders tc_bndrs tys
816 = [ mkAnonTyConBinder (mkTyVar name ty)
817 | (name, ty) <- fresh_names `zip` tys ]
818 where
819 fresh_names = freshNames (map getName (binderVars tc_bndrs))
820
821 freshNames :: [Name] -> [Name]
822 -- Make names whose Uniques and OccNames differ from
823 -- those in the 'avoid' list
824 freshNames avoids
825 = [ mkSystemName uniq occ
826 | n <- [0..]
827 , let uniq = mkAlphaTyVarUnique n
828 occ = mkTyVarOccFS (mkFastString ('x' : show n))
829
830 , not (uniq `elementOfUniqSet` avoid_uniqs)
831 , not (occ `elemOccSet` avoid_occs) ]
832
833 where
834 avoid_uniqs :: UniqSet Unique
835 avoid_uniqs = mkUniqSet (map getUnique avoids)
836
837 avoid_occs :: OccSet
838 avoid_occs = mkOccSet (map getOccName avoids)
839
840 -- | The 'Name' of the 'DataCon', giving it a unique, rooted identification
841 dataConName :: DataCon -> Name
842 dataConName = dcName
843
844 -- | The tag used for ordering 'DataCon's
845 dataConTag :: DataCon -> ConTag
846 dataConTag = dcTag
847
848 -- | The type constructor that we are building via this data constructor
849 dataConTyCon :: DataCon -> TyCon
850 dataConTyCon = dcRepTyCon
851
852 -- | The original type constructor used in the definition of this data
853 -- constructor. In case of a data family instance, that will be the family
854 -- type constructor.
855 dataConOrigTyCon :: DataCon -> TyCon
856 dataConOrigTyCon dc
857 | Just (tc, _) <- tyConFamInst_maybe (dcRepTyCon dc) = tc
858 | otherwise = dcRepTyCon dc
859
860 -- | The representation type of the data constructor, i.e. the sort
861 -- type that will represent values of this type at runtime
862 dataConRepType :: DataCon -> Type
863 dataConRepType = dcRepType
864
865 -- | Should the 'DataCon' be presented infix?
866 dataConIsInfix :: DataCon -> Bool
867 dataConIsInfix = dcInfix
868
869 -- | The universally-quantified type variables of the constructor
870 dataConUnivTyVars :: DataCon -> [TyVar]
871 dataConUnivTyVars (MkData { dcUnivTyVars = tvbs }) = binderVars tvbs
872
873 -- | 'TyBinder's for the universally-quantified type variables
874 dataConUnivTyVarBinders :: DataCon -> [TyVarBinder]
875 dataConUnivTyVarBinders = dcUnivTyVars
876
877 -- | The existentially-quantified type variables of the constructor
878 dataConExTyVars :: DataCon -> [TyVar]
879 dataConExTyVars (MkData { dcExTyVars = tvbs }) = binderVars tvbs
880
881 -- | 'TyBinder's for the existentially-quantified type variables
882 dataConExTyVarBinders :: DataCon -> [TyVarBinder]
883 dataConExTyVarBinders = dcExTyVars
884
885 -- | Both the universal and existentiatial type variables of the constructor
886 dataConAllTyVars :: DataCon -> [TyVar]
887 dataConAllTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
888 = binderVars (univ_tvs ++ ex_tvs)
889
890 -- | Equalities derived from the result type of the data constructor, as written
891 -- by the programmer in any GADT declaration. This includes *all* GADT-like
892 -- equalities, including those written in by hand by the programmer.
893 dataConEqSpec :: DataCon -> [EqSpec]
894 dataConEqSpec (MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })
895 = eq_spec ++
896 [ spec -- heterogeneous equality
897 | Just (tc, [_k1, _k2, ty1, ty2]) <- map splitTyConApp_maybe theta
898 , tc `hasKey` heqTyConKey
899 , spec <- case (getTyVar_maybe ty1, getTyVar_maybe ty2) of
900 (Just tv1, _) -> [mkEqSpec tv1 ty2]
901 (_, Just tv2) -> [mkEqSpec tv2 ty1]
902 _ -> []
903 ] ++
904 [ spec -- homogeneous equality
905 | Just (tc, [_k, ty1, ty2]) <- map splitTyConApp_maybe theta
906 , tc `hasKey` eqTyConKey
907 , spec <- case (getTyVar_maybe ty1, getTyVar_maybe ty2) of
908 (Just tv1, _) -> [mkEqSpec tv1 ty2]
909 (_, Just tv2) -> [mkEqSpec tv2 ty1]
910 _ -> []
911 ]
912
913
914 -- | The *full* constraints on the constructor type.
915 dataConTheta :: DataCon -> ThetaType
916 dataConTheta (MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })
917 = eqSpecPreds eq_spec ++ theta
918
919 -- | Get the Id of the 'DataCon' worker: a function that is the "actual"
920 -- constructor and has no top level binding in the program. The type may
921 -- be different from the obvious one written in the source program. Panics
922 -- if there is no such 'Id' for this 'DataCon'
923 dataConWorkId :: DataCon -> Id
924 dataConWorkId dc = dcWorkId dc
925
926 -- | Get the Id of the 'DataCon' wrapper: a function that wraps the "actual"
927 -- constructor so it has the type visible in the source program: c.f. 'dataConWorkId'.
928 -- Returns Nothing if there is no wrapper, which occurs for an algebraic data constructor
929 -- and also for a newtype (whose constructor is inlined compulsorily)
930 dataConWrapId_maybe :: DataCon -> Maybe Id
931 dataConWrapId_maybe dc = case dcRep dc of
932 NoDataConRep -> Nothing
933 DCR { dcr_wrap_id = wrap_id } -> Just wrap_id
934
935 -- | Returns an Id which looks like the Haskell-source constructor by using
936 -- the wrapper if it exists (see 'dataConWrapId_maybe') and failing over to
937 -- the worker (see 'dataConWorkId')
938 dataConWrapId :: DataCon -> Id
939 dataConWrapId dc = case dcRep dc of
940 NoDataConRep-> dcWorkId dc -- worker=wrapper
941 DCR { dcr_wrap_id = wrap_id } -> wrap_id
942
943 -- | Find all the 'Id's implicitly brought into scope by the data constructor. Currently,
944 -- the union of the 'dataConWorkId' and the 'dataConWrapId'
945 dataConImplicitTyThings :: DataCon -> [TyThing]
946 dataConImplicitTyThings (MkData { dcWorkId = work, dcRep = rep })
947 = [AnId work] ++ wrap_ids
948 where
949 wrap_ids = case rep of
950 NoDataConRep -> []
951 DCR { dcr_wrap_id = wrap } -> [AnId wrap]
952
953 -- | The labels for the fields of this particular 'DataCon'
954 dataConFieldLabels :: DataCon -> [FieldLabel]
955 dataConFieldLabels = dcFields
956
957 -- | Extract the type for any given labelled field of the 'DataCon'
958 dataConFieldType :: DataCon -> FieldLabelString -> Type
959 dataConFieldType con label
960 = case find ((== label) . flLabel . fst) (dcFields con `zip` dcOrigArgTys con) of
961 Just (_, ty) -> ty
962 Nothing -> pprPanic "dataConFieldType" (ppr con <+> ppr label)
963
964 -- | Strictness/unpack annotations, from user; or, for imported
965 -- DataCons, from the interface file
966 -- The list is in one-to-one correspondence with the arity of the 'DataCon'
967
968 dataConSrcBangs :: DataCon -> [HsSrcBang]
969 dataConSrcBangs = dcSrcBangs
970
971 -- | Source-level arity of the data constructor
972 dataConSourceArity :: DataCon -> Arity
973 dataConSourceArity (MkData { dcSourceArity = arity }) = arity
974
975 -- | Gives the number of actual fields in the /representation/ of the
976 -- data constructor. This may be more than appear in the source code;
977 -- the extra ones are the existentially quantified dictionaries
978 dataConRepArity :: DataCon -> Arity
979 dataConRepArity (MkData { dcRepArity = arity }) = arity
980
981 -- | Return whether there are any argument types for this 'DataCon's original source type
982 isNullarySrcDataCon :: DataCon -> Bool
983 isNullarySrcDataCon dc = null (dcOrigArgTys dc)
984
985 -- | Return whether there are any argument types for this 'DataCon's runtime representation type
986 isNullaryRepDataCon :: DataCon -> Bool
987 isNullaryRepDataCon dc = dataConRepArity dc == 0
988
989 dataConRepStrictness :: DataCon -> [StrictnessMark]
990 -- ^ Give the demands on the arguments of a
991 -- Core constructor application (Con dc args)
992 dataConRepStrictness dc = case dcRep dc of
993 NoDataConRep -> [NotMarkedStrict | _ <- dataConRepArgTys dc]
994 DCR { dcr_stricts = strs } -> strs
995
996 dataConImplBangs :: DataCon -> [HsImplBang]
997 -- The implementation decisions about the strictness/unpack of each
998 -- source program argument to the data constructor
999 dataConImplBangs dc
1000 = case dcRep dc of
1001 NoDataConRep -> replicate (dcSourceArity dc) HsLazy
1002 DCR { dcr_bangs = bangs } -> bangs
1003
1004 dataConBoxer :: DataCon -> Maybe DataConBoxer
1005 dataConBoxer (MkData { dcRep = DCR { dcr_boxer = boxer } }) = Just boxer
1006 dataConBoxer _ = Nothing
1007
1008 -- | The \"signature\" of the 'DataCon' returns, in order:
1009 --
1010 -- 1) The result of 'dataConAllTyVars',
1011 --
1012 -- 2) All the 'ThetaType's relating to the 'DataCon' (coercion, dictionary, implicit
1013 -- parameter - whatever)
1014 --
1015 -- 3) The type arguments to the constructor
1016 --
1017 -- 4) The /original/ result type of the 'DataCon'
1018 dataConSig :: DataCon -> ([TyVar], ThetaType, [Type], Type)
1019 dataConSig con@(MkData {dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
1020 = (dataConAllTyVars con, dataConTheta con, arg_tys, res_ty)
1021
1022 dataConInstSig
1023 :: DataCon
1024 -> [Type] -- Instantiate the *universal* tyvars with these types
1025 -> ([TyVar], ThetaType, [Type]) -- Return instantiated existentials
1026 -- theta and arg tys
1027 -- ^ Instantantiate the universal tyvars of a data con,
1028 -- returning the instantiated existentials, constraints, and args
1029 dataConInstSig (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs
1030 , dcEqSpec = eq_spec, dcOtherTheta = theta
1031 , dcOrigArgTys = arg_tys })
1032 univ_tys
1033 = ( ex_tvs'
1034 , substTheta subst (eqSpecPreds eq_spec ++ theta)
1035 , substTys subst arg_tys)
1036 where
1037 univ_subst = zipTvSubst (binderVars univ_tvs) univ_tys
1038 (subst, ex_tvs') = mapAccumL Type.substTyVarBndr univ_subst $
1039 binderVars ex_tvs
1040
1041
1042 -- | The \"full signature\" of the 'DataCon' returns, in order:
1043 --
1044 -- 1) The result of 'dataConUnivTyVars'
1045 --
1046 -- 2) The result of 'dataConExTyVars'
1047 --
1048 -- 3) The GADT equalities
1049 --
1050 -- 4) The result of 'dataConDictTheta'
1051 --
1052 -- 5) The original argument types to the 'DataCon' (i.e. before
1053 -- any change of the representation of the type)
1054 --
1055 -- 6) The original result type of the 'DataCon'
1056 dataConFullSig :: DataCon
1057 -> ([TyVar], [TyVar], [EqSpec], ThetaType, [Type], Type)
1058 dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
1059 dcEqSpec = eq_spec, dcOtherTheta = theta,
1060 dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
1061 = (binderVars univ_tvs, binderVars ex_tvs, eq_spec, theta, arg_tys, res_ty)
1062
1063 dataConOrigResTy :: DataCon -> Type
1064 dataConOrigResTy dc = dcOrigResTy dc
1065
1066 -- | The \"stupid theta\" of the 'DataCon', such as @data Eq a@ in:
1067 --
1068 -- > data Eq a => T a = ...
1069 dataConStupidTheta :: DataCon -> ThetaType
1070 dataConStupidTheta dc = dcStupidTheta dc
1071
1072 dataConUserType :: DataCon -> Type
1073 -- ^ The user-declared type of the data constructor
1074 -- in the nice-to-read form:
1075 --
1076 -- > T :: forall a b. a -> b -> T [a]
1077 --
1078 -- rather than:
1079 --
1080 -- > T :: forall a c. forall b. (c~[a]) => a -> b -> T c
1081 --
1082 -- NB: If the constructor is part of a data instance, the result type
1083 -- mentions the family tycon, not the internal one.
1084 dataConUserType (MkData { dcUnivTyVars = univ_tvs,
1085 dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
1086 dcOtherTheta = theta, dcOrigArgTys = arg_tys,
1087 dcOrigResTy = res_ty })
1088 = mkForAllTys (filterEqSpec eq_spec univ_tvs) $
1089 mkForAllTys ex_tvs $
1090 mkFunTys theta $
1091 mkFunTys arg_tys $
1092 res_ty
1093 where
1094
1095 -- | Finds the instantiated types of the arguments required to construct a 'DataCon' representation
1096 -- NB: these INCLUDE any dictionary args
1097 -- but EXCLUDE the data-declaration context, which is discarded
1098 -- It's all post-flattening etc; this is a representation type
1099 dataConInstArgTys :: DataCon -- ^ A datacon with no existentials or equality constraints
1100 -- However, it can have a dcTheta (notably it can be a
1101 -- class dictionary, with superclasses)
1102 -> [Type] -- ^ Instantiated at these types
1103 -> [Type]
1104 dataConInstArgTys dc@(MkData {dcUnivTyVars = univ_tvs,
1105 dcExTyVars = ex_tvs}) inst_tys
1106 = ASSERT2( length univ_tvs == length inst_tys
1107 , text "dataConInstArgTys" <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
1108 ASSERT2( null ex_tvs, ppr dc )
1109 map (substTyWith (binderVars univ_tvs) inst_tys) (dataConRepArgTys dc)
1110
1111 -- | Returns just the instantiated /value/ argument types of a 'DataCon',
1112 -- (excluding dictionary args)
1113 dataConInstOrigArgTys
1114 :: DataCon -- Works for any DataCon
1115 -> [Type] -- Includes existential tyvar args, but NOT
1116 -- equality constraints or dicts
1117 -> [Type]
1118 -- For vanilla datacons, it's all quite straightforward
1119 -- But for the call in MatchCon, we really do want just the value args
1120 dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
1121 dcUnivTyVars = univ_tvs,
1122 dcExTyVars = ex_tvs}) inst_tys
1123 = ASSERT2( length tyvars == length inst_tys
1124 , text "dataConInstOrigArgTys" <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
1125 map (substTyWith tyvars inst_tys) arg_tys
1126 where
1127 tyvars = binderVars (univ_tvs ++ ex_tvs)
1128
1129 -- | Returns the argument types of the wrapper, excluding all dictionary arguments
1130 -- and without substituting for any type variables
1131 dataConOrigArgTys :: DataCon -> [Type]
1132 dataConOrigArgTys dc = dcOrigArgTys dc
1133
1134 -- | Returns the arg types of the worker, including *all*
1135 -- evidence, after any flattening has been done and without substituting for
1136 -- any type variables
1137 dataConRepArgTys :: DataCon -> [Type]
1138 dataConRepArgTys (MkData { dcRep = rep
1139 , dcEqSpec = eq_spec
1140 , dcOtherTheta = theta
1141 , dcOrigArgTys = orig_arg_tys })
1142 = case rep of
1143 NoDataConRep -> ASSERT( null eq_spec ) theta ++ orig_arg_tys
1144 DCR { dcr_arg_tys = arg_tys } -> arg_tys
1145
1146 -- | The string @package:module.name@ identifying a constructor, which is attached
1147 -- to its info table and used by the GHCi debugger and the heap profiler
1148 dataConIdentity :: DataCon -> [Word8]
1149 -- We want this string to be UTF-8, so we get the bytes directly from the FastStrings.
1150 dataConIdentity dc = bytesFS (unitIdFS (moduleUnitId mod)) ++
1151 fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++
1152 fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
1153 where name = dataConName dc
1154 mod = ASSERT( isExternalName name ) nameModule name
1155
1156 isTupleDataCon :: DataCon -> Bool
1157 isTupleDataCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc
1158
1159 isUnboxedTupleCon :: DataCon -> Bool
1160 isUnboxedTupleCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc
1161
1162 isUnboxedSumCon :: DataCon -> Bool
1163 isUnboxedSumCon (MkData {dcRepTyCon = tc}) = isUnboxedSumTyCon tc
1164
1165 -- | Vanilla 'DataCon's are those that are nice boring Haskell 98 constructors
1166 isVanillaDataCon :: DataCon -> Bool
1167 isVanillaDataCon dc = dcVanilla dc
1168
1169 -- | Should this DataCon be allowed in a type even without -XDataKinds?
1170 -- Currently, only Lifted & Unlifted
1171 specialPromotedDc :: DataCon -> Bool
1172 specialPromotedDc = isKindTyCon . dataConTyCon
1173
1174 -- | Was this datacon promotable before GHC 8.0? That is, is it promotable
1175 -- without -XTypeInType
1176 isLegacyPromotableDataCon :: DataCon -> Bool
1177 isLegacyPromotableDataCon dc
1178 = null (dataConEqSpec dc) -- no GADTs
1179 && null (dataConTheta dc) -- no context
1180 && not (isFamInstTyCon (dataConTyCon dc)) -- no data instance constructors
1181 && allUFM isLegacyPromotableTyCon (tyConsOfType (dataConUserType dc))
1182
1183 -- | Was this tycon promotable before GHC 8.0? That is, is it promotable
1184 -- without -XTypeInType
1185 isLegacyPromotableTyCon :: TyCon -> Bool
1186 isLegacyPromotableTyCon tc
1187 = isVanillaAlgTyCon tc ||
1188 -- This returns True more often than it should, but it's quite painful
1189 -- to make this fully accurate. And no harm is caused; we just don't
1190 -- require -XTypeInType every time we need to. (We'll always require
1191 -- -XDataKinds, though, so there's no standards-compliance issue.)
1192 isFunTyCon tc || isKindTyCon tc
1193
1194 classDataCon :: Class -> DataCon
1195 classDataCon clas = case tyConDataCons (classTyCon clas) of
1196 (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
1197 [] -> panic "classDataCon"
1198
1199 dataConCannotMatch :: [Type] -> DataCon -> Bool
1200 -- Returns True iff the data con *definitely cannot* match a
1201 -- scrutinee of type (T tys)
1202 -- where T is the dcRepTyCon for the data con
1203 dataConCannotMatch tys con
1204 | null inst_theta = False -- Common
1205 | all isTyVarTy tys = False -- Also common
1206 | otherwise = typesCantMatch (concatMap predEqs inst_theta)
1207 where
1208 (_, inst_theta, _) = dataConInstSig con tys
1209
1210 -- TODO: could gather equalities from superclasses too
1211 predEqs pred = case classifyPredType pred of
1212 EqPred NomEq ty1 ty2 -> [(ty1, ty2)]
1213 ClassPred eq [_, ty1, ty2]
1214 | eq `hasKey` eqTyConKey -> [(ty1, ty2)]
1215 _ -> []
1216
1217 {-
1218 %************************************************************************
1219 %* *
1220 Promoting of data types to the kind level
1221 * *
1222 ************************************************************************
1223
1224 -}
1225
1226 promoteDataCon :: DataCon -> TyCon
1227 promoteDataCon (MkData { dcPromoted = tc }) = tc
1228
1229 {-
1230 ************************************************************************
1231 * *
1232 \subsection{Splitting products}
1233 * *
1234 ************************************************************************
1235 -}
1236
1237 -- | Extract the type constructor, type argument, data constructor and it's
1238 -- /representation/ argument types from a type if it is a product type.
1239 --
1240 -- Precisely, we return @Just@ for any type that is all of:
1241 --
1242 -- * Concrete (i.e. constructors visible)
1243 --
1244 -- * Single-constructor
1245 --
1246 -- * Not existentially quantified
1247 --
1248 -- Whether the type is a @data@ type or a @newtype@
1249 splitDataProductType_maybe
1250 :: Type -- ^ A product type, perhaps
1251 -> Maybe (TyCon, -- The type constructor
1252 [Type], -- Type args of the tycon
1253 DataCon, -- The data constructor
1254 [Type]) -- Its /representation/ arg types
1255
1256 -- Rejecting existentials is conservative. Maybe some things
1257 -- could be made to work with them, but I'm not going to sweat
1258 -- it through till someone finds it's important.
1259
1260 splitDataProductType_maybe ty
1261 | Just (tycon, ty_args) <- splitTyConApp_maybe ty
1262 , Just con <- isDataProductTyCon_maybe tycon
1263 = Just (tycon, ty_args, con, dataConInstArgTys con ty_args)
1264 | otherwise
1265 = Nothing
1266
1267 {-
1268 ************************************************************************
1269 * *
1270 Building an algebraic data type
1271 * *
1272 ************************************************************************
1273
1274 buildAlgTyCon is here because it is called from TysWiredIn, which can
1275 depend on this module, but not on BuildTyCl.
1276 -}
1277
1278 buildAlgTyCon :: Name
1279 -> [TyVar] -- ^ Kind variables and type variables
1280 -> [Role]
1281 -> Maybe CType
1282 -> ThetaType -- ^ Stupid theta
1283 -> AlgTyConRhs
1284 -> Bool -- ^ True <=> was declared in GADT syntax
1285 -> AlgTyConFlav
1286 -> TyCon
1287
1288 buildAlgTyCon tc_name ktvs roles cType stupid_theta rhs
1289 gadt_syn parent
1290 = mkAlgTyCon tc_name binders liftedTypeKind roles cType stupid_theta
1291 rhs parent gadt_syn
1292 where
1293 binders = mkTyConBindersPreferAnon ktvs liftedTypeKind