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