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