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