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