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