2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
4 \section[DataCon]{@DataCon@: Data Constructors}
8 DataCon, DataConIds(..),
11 dataConRepType, dataConSig, dataConFullSig,
12 dataConName, dataConTag, dataConTyCon, dataConUserType,
13 dataConUnivTyVars, dataConExTyVars, dataConAllTyVars, dataConResTys,
14 dataConEqSpec, dataConTheta, dataConStupidTheta,
15 dataConInstArgTys, dataConOrigArgTys,
16 dataConInstOrigArgTys, dataConRepArgTys,
17 dataConFieldLabels, dataConFieldType,
18 dataConStrictMarks, dataConExStricts,
19 dataConSourceArity, dataConRepArity,
21 dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds,
23 isNullarySrcDataCon, isNullaryRepDataCon, isTupleCon, isUnboxedTupleCon,
24 isVanillaDataCon, classDataCon,
26 splitProductType_maybe, splitProductType, deepSplitProductType,
27 deepSplitProductType_maybe
30 #include "HsVersions.h"
32 import Type ( Type, ThetaType,
33 substTyWith, substTyVar, mkTopTvSubst,
34 mkForAllTys, mkFunTys, mkTyConApp, mkTyVarTy, mkTyVarTys,
35 splitTyConApp_maybe, newTyConInstRhs,
36 mkPredTys, isStrictPred, pprType
38 import Coercion ( isEqPred, mkEqPred )
39 import TyCon ( TyCon, FieldLabel, tyConDataCons,
40 isProductTyCon, isTupleTyCon, isUnboxedTupleTyCon,
41 isNewTyCon, isRecursiveTyCon )
42 import Class ( Class, classTyCon )
43 import Name ( Name, NamedThing(..), nameUnique )
44 import Var ( TyVar, Id )
45 import BasicTypes ( Arity, StrictnessMark(..) )
47 import Unique ( Unique, Uniquable(..) )
48 import ListSetOps ( assoc, minusList )
49 import Util ( zipEqual, zipWithEqual )
50 import List ( partition )
51 import Maybes ( expectJust )
55 Data constructor representation
56 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
57 Consider the following Haskell data type declaration
59 data T = T !Int ![Int]
61 Using the strictness annotations, GHC will represent this as
65 That is, the Int has been unboxed. Furthermore, the Haskell source construction
75 That is, the first argument is unboxed, and the second is evaluated. Finally,
76 pattern matching is translated too:
78 case e of { T a b -> ... }
82 case e of { T a' b -> let a = I# a' in ... }
84 To keep ourselves sane, we name the different versions of the data constructor
85 differently, as follows.
88 Note [Data Constructor Naming]
89 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
90 Each data constructor C has two, and possibly three, Names associated with it:
92 OccName Name space Used for
93 ---------------------------------------------------------------------------
94 * The "source data con" C DataName The DataCon itself
95 * The "real data con" C VarName Its worker Id
96 * The "wrapper data con" $WC VarName Wrapper Id (optional)
98 Each of these three has a distinct Unique. The "source data con" name
99 appears in the output of the renamer, and names the Haskell-source
100 data constructor. The type checker translates it into either the wrapper Id
101 (if it exists) or worker Id (otherwise).
103 The data con has one or two Ids associated with it:
105 The "worker Id", is the actual data constructor.
106 Its type may be different to the Haskell source constructor
108 - useless dict args are dropped
109 - strict args may be flattened
110 The worker is very like a primop, in that it has no binding.
112 Newtypes have no worker Id
115 The "wrapper Id", $WC, whose type is exactly what it looks like
116 in the source program. It is an ordinary function,
117 and it gets a top-level binding like any other function.
119 The wrapper Id isn't generated for a data type if the worker
120 and wrapper are identical. It's always generated for a newtype.
124 A note about the stupid context
125 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
126 Data types can have a context:
128 data (Eq a, Ord b) => T a b = T1 a b | T2 a
130 and that makes the constructors have a context too
131 (notice that T2's context is "thinned"):
133 T1 :: (Eq a, Ord b) => a -> b -> T a b
134 T2 :: (Eq a) => a -> T a b
136 Furthermore, this context pops up when pattern matching
137 (though GHC hasn't implemented this, but it is in H98, and
138 I've fixed GHC so that it now does):
142 f :: Eq a => T a b -> a
144 I say the context is "stupid" because the dictionaries passed
145 are immediately discarded -- they do nothing and have no benefit.
146 It's a flaw in the language.
148 Up to now [March 2002] I have put this stupid context into the
149 type of the "wrapper" constructors functions, T1 and T2, but
150 that turned out to be jolly inconvenient for generics, and
151 record update, and other functions that build values of type T
152 (because they don't have suitable dictionaries available).
154 So now I've taken the stupid context out. I simply deal with
155 it separately in the type checker on occurrences of a
156 constructor, either in an expression or in a pattern.
158 [May 2003: actually I think this decision could evasily be
159 reversed now, and probably should be. Generics could be
160 disabled for types with a stupid context; record updates now
161 (H98) needs the context too; etc. It's an unforced change, so
162 I'm leaving it for now --- but it does seem odd that the
163 wrapper doesn't include the stupid context.]
165 [July 04] With the advent of generalised data types, it's less obvious
166 what the "stupid context" is. Consider
167 C :: forall a. Ord a => a -> a -> T (Foo a)
168 Does the C constructor in Core contain the Ord dictionary? Yes, it must:
173 C a (d:Ord a) (p:a) (q:a) -> compare d p q
175 Note that (Foo a) might not be an instance of Ord.
177 %************************************************************************
179 \subsection{Data constructors}
181 %************************************************************************
186 dcName :: Name, -- This is the name of the *source data con*
187 -- (see "Note [Data Constructor Naming]" above)
188 dcUnique :: Unique, -- Cached from Name
193 -- *** As declared by the user
195 -- MkT :: forall x y. (Ord x) => x -> y -> T (x,y)
197 -- *** As represented internally
199 -- MkT :: forall a. forall x y. (a:=:(x,y), Ord x) => x -> y -> T a
201 -- The next six fields express the type of the constructor, in pieces
204 -- dcUnivTyVars = [a]
205 -- dcExTyVars = [x,y]
206 -- dcEqSpec = [a:=:(x,y)]
208 -- dcOrigArgTys = [a,List b]
211 dcVanilla :: Bool, -- True <=> This is a vanilla Haskell 98 data constructor
212 -- Its type is of form
213 -- forall a1..an . t1 -> ... tm -> T a1..an
214 -- No existentials, no coercions, nothing.
215 -- That is: dcExTyVars = dcEqSpec = dcTheta = []
216 -- NB 1: newtypes always have a vanilla data con
217 -- NB 2: a vanilla constructor can still be declared in GADT-style
218 -- syntax, provided its type looks like the above.
219 -- The declaration format is held in the TyCon (algTcGadtSyntax)
221 dcUnivTyVars :: [TyVar], -- Universally-quantified type vars
222 dcExTyVars :: [TyVar], -- Existentially-quantified type vars
223 -- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
224 -- FOR THE PARENT TyCon. With GADTs the data con might not even have
225 -- the same number of type variables.
226 -- [This is a change (Oct05): previously, vanilla datacons guaranteed to
227 -- have the same type variables as their parent TyCon, but that seems ugly.]
229 dcEqSpec :: [(TyVar,Type)], -- Equalities derived from the result type,
230 -- *as written by the programmer*
231 -- This field allows us to move conveniently between the two ways
232 -- of representing a GADT constructor's type:
233 -- MkT :: forall a b. (a :=: [b]) => b -> T a
234 -- MkT :: forall b. b -> T [b]
235 -- Each equality is of the form (a :=: ty), where 'a' is one of
236 -- the universally quantified type variables
238 dcTheta :: ThetaType, -- The context of the constructor
239 -- In GADT form, this is *exactly* what the programmer writes, even if
240 -- the context constrains only universally quantified variables
241 -- MkT :: forall a. Eq a => a -> T a
242 -- It may contain user-written equality predicates too
244 dcStupidTheta :: ThetaType, -- The context of the data type declaration
245 -- data Eq a => T a = ...
246 -- or, rather, a "thinned" version thereof
247 -- "Thinned", because the Report says
248 -- to eliminate any constraints that don't mention
249 -- tyvars free in the arg types for this constructor
251 -- INVARIANT: the free tyvars of dcStupidTheta are a subset of dcUnivTyVars
252 -- Reason: dcStupidTeta is gotten by thinning the stupid theta from the tycon
254 -- "Stupid", because the dictionaries aren't used for anything.
255 -- Indeed, [as of March 02] they are no longer in the type of
256 -- the wrapper Id, because that makes it harder to use the wrap-id
257 -- to rebuild values after record selection or in generics.
259 dcOrigArgTys :: [Type], -- Original argument types
260 -- (before unboxing and flattening of strict fields)
262 -- Result type of constructor is T t1..tn
263 dcTyCon :: TyCon, -- Result tycon, T
265 -- Now the strictness annotations and field labels of the constructor
266 dcStrictMarks :: [StrictnessMark],
267 -- Strictness annotations as decided by the compiler.
268 -- Does *not* include the existential dictionaries
269 -- length = dataConSourceArity dataCon
271 dcFields :: [FieldLabel],
272 -- Field labels for this constructor, in the
273 -- same order as the argument types;
274 -- length = 0 (if not a record) or dataConSourceArity.
276 -- Constructor representation
277 dcRepArgTys :: [Type], -- Final, representation argument types,
278 -- after unboxing and flattening,
279 -- and *including* existential dictionaries
281 dcRepStrictness :: [StrictnessMark], -- One for each *representation* argument
283 dcRepType :: Type, -- Type of the constructor
284 -- forall a x y. (a:=:(x,y), Ord x) => x -> y -> MkT a
285 -- (this is *not* of the constructor wrapper Id:
286 -- see Note [Data con representation] below)
287 -- Notice that the existential type parameters come *second*.
288 -- Reason: in a case expression we may find:
289 -- case (e :: T t) of { MkT b (d:Ord b) (x:t) (xs:[b]) -> ... }
290 -- It's convenient to apply the rep-type of MkT to 't', to get
291 -- forall b. Ord b => ...
292 -- and use that to check the pattern. Mind you, this is really only
296 -- Finally, the curried worker function that corresponds to the constructor
297 -- It doesn't have an unfolding; the code generator saturates these Ids
298 -- and allocates a real constructor when it finds one.
300 -- An entirely separate wrapper function is built in TcTyDecls
303 dcInfix :: Bool -- True <=> declared infix
304 -- Used for Template Haskell and 'deriving' only
305 -- The actual fixity is stored elsewhere
309 = NewDC Id -- Newtypes have only a wrapper, but no worker
310 | AlgDC (Maybe Id) Id -- Algebraic data types always have a worker, and
311 -- may or may not have a wrapper, depending on whether
312 -- the wrapper does anything.
314 -- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments
316 -- The wrapper takes dcOrigArgTys as its arguments
317 -- The worker takes dcRepArgTys as its arguments
318 -- If the worker is absent, dcRepArgTys is the same as dcOrigArgTys
320 -- The 'Nothing' case of AlgDC is important
321 -- Not only is this efficient,
322 -- but it also ensures that the wrapper is replaced
323 -- by the worker (becuase it *is* the wroker)
324 -- even when there are no args. E.g. in
326 -- the (:) *is* the worker.
327 -- This is really important in rule matching,
328 -- (We could match on the wrappers,
329 -- but that makes it less likely that rules will match
330 -- when we bring bits of unfoldings together.)
335 fIRST_TAG = 1 -- Tags allocated from here for real constructors
338 Note [Data con representation]
339 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
340 The dcRepType field contains the type of the representation of a contructor
341 This may differ from the type of the contructor *Id* (built
342 by MkId.mkDataConId) for two reasons:
343 a) the constructor Id may be overloaded, but the dictionary isn't stored
344 e.g. data Eq a => T a = MkT a a
346 b) the constructor may store an unboxed version of a strict field.
348 Here's an example illustrating both:
349 data Ord a => T a = MkT Int! a
351 T :: Ord a => Int -> a -> T a
353 Trep :: Int# -> a -> T a
354 Actually, the unboxed part isn't implemented yet!
357 %************************************************************************
359 \subsection{Instances}
361 %************************************************************************
364 instance Eq DataCon where
365 a == b = getUnique a == getUnique b
366 a /= b = getUnique a /= getUnique b
368 instance Ord DataCon where
369 a <= b = getUnique a <= getUnique b
370 a < b = getUnique a < getUnique b
371 a >= b = getUnique a >= getUnique b
372 a > b = getUnique a > getUnique b
373 compare a b = getUnique a `compare` getUnique b
375 instance Uniquable DataCon where
378 instance NamedThing DataCon where
381 instance Outputable DataCon where
382 ppr con = ppr (dataConName con)
384 instance Show DataCon where
385 showsPrec p con = showsPrecSDoc p (ppr con)
389 %************************************************************************
391 \subsection{Construction}
393 %************************************************************************
397 -> Bool -- Declared infix
398 -> [StrictnessMark] -> [FieldLabel]
399 -> [TyVar] -> [TyVar]
400 -> [(TyVar,Type)] -> ThetaType
402 -> ThetaType -> DataConIds
404 -- Can get the tag from the TyCon
406 mkDataCon name declared_infix
407 arg_stricts -- Must match orig_arg_tys 1-1
413 = ASSERT( not (any isEqPred theta) )
414 -- We don't currently allow any equality predicates on
415 -- a data constructor (apart from the GADT ones in eq_spec)
418 is_vanilla = null ex_tvs && null eq_spec && null theta
419 con = ASSERT( is_vanilla || not (isNewTyCon tycon) )
420 -- Invariant: newtypes have a vanilla data-con
421 MkData {dcName = name, dcUnique = nameUnique name,
422 dcVanilla = is_vanilla, dcInfix = declared_infix,
423 dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
425 dcStupidTheta = stupid_theta, dcTheta = theta,
426 dcOrigArgTys = orig_arg_tys, dcTyCon = tycon,
427 dcRepArgTys = rep_arg_tys,
428 dcStrictMarks = arg_stricts, dcRepStrictness = rep_arg_stricts,
429 dcFields = fields, dcTag = tag, dcRepType = ty,
432 -- Strictness marks for source-args
433 -- *after unboxing choices*,
434 -- but *including existential dictionaries*
436 -- The 'arg_stricts' passed to mkDataCon are simply those for the
437 -- source-language arguments. We add extra ones for the
438 -- dictionary arguments right here.
439 dict_tys = mkPredTys theta
440 real_arg_tys = dict_tys ++ orig_arg_tys
441 real_stricts = map mk_dict_strict_mark theta ++ arg_stricts
443 -- Representation arguments and demands
444 -- To do: eliminate duplication with MkId
445 (rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
447 tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
448 ty = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $
449 mkFunTys (mkPredTys (eqSpecPreds eq_spec)) $
450 -- NB: the dict args are already in rep_arg_tys
451 -- because they might be flattened..
452 -- but the equality predicates are not
453 mkFunTys rep_arg_tys $
454 mkTyConApp tycon (mkTyVarTys univ_tvs)
456 eqSpecPreds :: [(TyVar,Type)] -> ThetaType
457 eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv, ty) | (tv,ty) <- spec ]
459 mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
460 | otherwise = NotMarkedStrict
464 dataConName :: DataCon -> Name
467 dataConTag :: DataCon -> ConTag
470 dataConTyCon :: DataCon -> TyCon
471 dataConTyCon = dcTyCon
473 dataConRepType :: DataCon -> Type
474 dataConRepType = dcRepType
476 dataConIsInfix :: DataCon -> Bool
477 dataConIsInfix = dcInfix
479 dataConUnivTyVars :: DataCon -> [TyVar]
480 dataConUnivTyVars = dcUnivTyVars
482 dataConExTyVars :: DataCon -> [TyVar]
483 dataConExTyVars = dcExTyVars
485 dataConAllTyVars :: DataCon -> [TyVar]
486 dataConAllTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
489 dataConEqSpec :: DataCon -> [(TyVar,Type)]
490 dataConEqSpec = dcEqSpec
492 dataConTheta :: DataCon -> ThetaType
493 dataConTheta = dcTheta
495 dataConWorkId :: DataCon -> Id
496 dataConWorkId dc = case dcIds dc of
497 AlgDC _ wrk_id -> wrk_id
498 NewDC _ -> pprPanic "dataConWorkId" (ppr dc)
500 dataConWrapId_maybe :: DataCon -> Maybe Id
501 -- Returns Nothing if there is no wrapper for an algebraic data con
502 -- and also for a newtype (whose constructor is inlined compulsorily)
503 dataConWrapId_maybe dc = case dcIds dc of
504 AlgDC mb_wrap _ -> mb_wrap
505 NewDC wrap -> Nothing
507 dataConWrapId :: DataCon -> Id
508 -- Returns an Id which looks like the Haskell-source constructor
509 dataConWrapId dc = case dcIds dc of
510 AlgDC (Just wrap) _ -> wrap
511 AlgDC Nothing wrk -> wrk -- worker=wrapper
514 dataConImplicitIds :: DataCon -> [Id]
515 dataConImplicitIds dc = case dcIds dc of
516 AlgDC (Just wrap) work -> [wrap,work]
517 AlgDC Nothing work -> [work]
520 dataConFieldLabels :: DataCon -> [FieldLabel]
521 dataConFieldLabels = dcFields
523 dataConFieldType :: DataCon -> FieldLabel -> Type
524 dataConFieldType con label = expectJust "unexpected label" $
525 lookup label (dcFields con `zip` dcOrigArgTys con)
527 dataConStrictMarks :: DataCon -> [StrictnessMark]
528 dataConStrictMarks = dcStrictMarks
530 dataConExStricts :: DataCon -> [StrictnessMark]
531 -- Strictness of *existential* arguments only
532 -- Usually empty, so we don't bother to cache this
533 dataConExStricts dc = map mk_dict_strict_mark (dcTheta dc)
535 dataConSourceArity :: DataCon -> Arity
536 -- Source-level arity of the data constructor
537 dataConSourceArity dc = length (dcOrigArgTys dc)
539 -- dataConRepArity gives the number of actual fields in the
540 -- {\em representation} of the data constructor. This may be more than appear
541 -- in the source code; the extra ones are the existentially quantified
543 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
545 isNullarySrcDataCon, isNullaryRepDataCon :: DataCon -> Bool
546 isNullarySrcDataCon dc = null (dcOrigArgTys dc)
547 isNullaryRepDataCon dc = null (dcRepArgTys dc)
549 dataConRepStrictness :: DataCon -> [StrictnessMark]
550 -- Give the demands on the arguments of a
551 -- Core constructor application (Con dc args)
552 dataConRepStrictness dc = dcRepStrictness dc
554 dataConSig :: DataCon -> ([TyVar], ThetaType, [Type])
555 dataConSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
556 dcTheta = theta, dcOrigArgTys = arg_tys, dcTyCon = tycon})
557 = (univ_tvs ++ ex_tvs, eqSpecPreds eq_spec ++ theta, arg_tys)
559 dataConFullSig :: DataCon
560 -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, [Type])
561 dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
562 dcTheta = theta, dcOrigArgTys = arg_tys, dcTyCon = tycon})
563 = (univ_tvs, ex_tvs, eq_spec, theta, arg_tys)
565 dataConStupidTheta :: DataCon -> ThetaType
566 dataConStupidTheta dc = dcStupidTheta dc
568 dataConResTys :: DataCon -> [Type]
569 dataConResTys dc = [substTyVar env tv | tv <- dcUnivTyVars dc]
571 env = mkTopTvSubst (dcEqSpec dc)
573 dataConUserType :: DataCon -> Type
574 -- The user-declared type of the data constructor
575 -- in the nice-to-read form
576 -- T :: forall a. a -> T [a]
578 -- T :: forall b. forall a. (a=[b]) => a -> T b
579 dataConUserType (MkData { dcUnivTyVars = univ_tvs,
580 dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
581 dcTheta = theta, dcOrigArgTys = arg_tys,
583 = mkForAllTys ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs) $
584 mkFunTys (mkPredTys theta) $
586 mkTyConApp tycon (map (substTyVar subst) univ_tvs)
588 subst = mkTopTvSubst eq_spec
590 dataConInstArgTys :: DataCon
591 -> [Type] -- Instantiated at these types
592 -- NB: these INCLUDE the existentially quantified arg types
593 -> [Type] -- Needs arguments of these types
594 -- NB: these INCLUDE the existentially quantified dict args
595 -- but EXCLUDE the data-decl context which is discarded
596 -- It's all post-flattening etc; this is a representation type
597 dataConInstArgTys (MkData {dcRepArgTys = arg_tys,
598 dcUnivTyVars = univ_tvs,
599 dcExTyVars = ex_tvs}) inst_tys
600 = ASSERT( length tyvars == length inst_tys )
601 map (substTyWith tyvars inst_tys) arg_tys
603 tyvars = univ_tvs ++ ex_tvs
605 -- And the same deal for the original arg tys
606 dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
607 dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
608 dcUnivTyVars = univ_tvs,
609 dcExTyVars = ex_tvs}) inst_tys
610 = ASSERT2( length tyvars == length inst_tys, ptext SLIT("dataConInstOrigArgTys") <+> ppr dc <+> ppr inst_tys )
611 map (substTyWith tyvars inst_tys) arg_tys
613 tyvars = univ_tvs ++ ex_tvs
616 These two functions get the real argument types of the constructor,
617 without substituting for any type variables.
619 dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
621 dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
622 after any flattening has been done.
625 dataConOrigArgTys :: DataCon -> [Type]
626 dataConOrigArgTys dc = dcOrigArgTys dc
628 dataConRepArgTys :: DataCon -> [Type]
629 dataConRepArgTys dc = dcRepArgTys dc
634 isTupleCon :: DataCon -> Bool
635 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
637 isUnboxedTupleCon :: DataCon -> Bool
638 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
640 isVanillaDataCon :: DataCon -> Bool
641 isVanillaDataCon dc = dcVanilla dc
646 classDataCon :: Class -> DataCon
647 classDataCon clas = case tyConDataCons (classTyCon clas) of
648 (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
651 %************************************************************************
653 \subsection{Splitting products}
655 %************************************************************************
658 splitProductType_maybe
659 :: Type -- A product type, perhaps
660 -> Maybe (TyCon, -- The type constructor
661 [Type], -- Type args of the tycon
662 DataCon, -- The data constructor
663 [Type]) -- Its *representation* arg types
665 -- Returns (Just ...) for any
666 -- concrete (i.e. constructors visible)
667 -- single-constructor
668 -- not existentially quantified
669 -- type whether a data type or a new type
671 -- Rejecing existentials is conservative. Maybe some things
672 -- could be made to work with them, but I'm not going to sweat
673 -- it through till someone finds it's important.
675 splitProductType_maybe ty
676 = case splitTyConApp_maybe ty of
678 | isProductTyCon tycon -- Includes check for non-existential,
679 -- and for constructors visible
680 -> Just (tycon, ty_args, data_con, dataConInstArgTys data_con ty_args)
682 data_con = head (tyConDataCons tycon)
685 splitProductType str ty
686 = case splitProductType_maybe ty of
688 Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
691 deepSplitProductType_maybe ty
692 = do { (res@(tycon, tycon_args, _, _)) <- splitProductType_maybe ty
694 | isNewTyCon tycon && not (isRecursiveTyCon tycon)
695 = deepSplitProductType_maybe (newTyConInstRhs tycon tycon_args)
696 | otherwise = Just res}
700 deepSplitProductType str ty
701 = case deepSplitProductType_maybe ty of
703 Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
705 computeRep :: [StrictnessMark] -- Original arg strictness
706 -> [Type] -- and types
707 -> ([StrictnessMark], -- Representation arg strictness
710 computeRep stricts tys
711 = unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
713 unbox NotMarkedStrict ty = [(NotMarkedStrict, ty)]
714 unbox MarkedStrict ty = [(MarkedStrict, ty)]
715 unbox MarkedUnboxed ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
717 (tycon, tycon_args, arg_dc, arg_tys)
718 = deepSplitProductType "unbox_strict_arg_ty" ty