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