2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1998
5 \section[DataCon]{@DataCon@: Data Constructors}
9 DataCon, DataConIds(..),
12 dataConRepType, dataConSig, dataConFullSig,
13 dataConName, dataConTag, dataConTyCon, dataConUserType,
14 dataConUnivTyVars, dataConExTyVars, dataConAllTyVars, dataConResTys,
15 dataConEqSpec, eqSpecPreds, dataConTheta, dataConStupidTheta,
16 dataConInstArgTys, dataConOrigArgTys,
17 dataConInstOrigArgTys, dataConRepArgTys,
18 dataConFieldLabels, dataConFieldType,
19 dataConStrictMarks, dataConExStricts,
20 dataConSourceArity, dataConRepArity,
22 dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds,
24 isNullarySrcDataCon, isNullaryRepDataCon, isTupleCon, isUnboxedTupleCon,
25 isVanillaDataCon, classDataCon,
27 splitProductType_maybe, splitProductType, deepSplitProductType,
28 deepSplitProductType_maybe
31 #include "HsVersions.h"
49 Data constructor representation
50 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
51 Consider the following Haskell data type declaration
53 data T = T !Int ![Int]
55 Using the strictness annotations, GHC will represent this as
59 That is, the Int has been unboxed. Furthermore, the Haskell source construction
69 That is, the first argument is unboxed, and the second is evaluated. Finally,
70 pattern matching is translated too:
72 case e of { T a b -> ... }
76 case e of { T a' b -> let a = I# a' in ... }
78 To keep ourselves sane, we name the different versions of the data constructor
79 differently, as follows.
82 Note [Data Constructor Naming]
83 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
84 Each data constructor C has two, and possibly three, Names associated with it:
86 OccName Name space Used for
87 ---------------------------------------------------------------------------
88 * The "source data con" C DataName The DataCon itself
89 * The "real data con" C VarName Its worker Id
90 * The "wrapper data con" $WC VarName Wrapper Id (optional)
92 Each of these three has a distinct Unique. The "source data con" name
93 appears in the output of the renamer, and names the Haskell-source
94 data constructor. The type checker translates it into either the wrapper Id
95 (if it exists) or worker Id (otherwise).
97 The data con has one or two Ids associated with it:
99 The "worker Id", is the actual data constructor.
100 * Every data constructor (newtype or data type) has a worker
102 * The worker is very like a primop, in that it has no binding.
104 * For a *data* type, the worker *is* the data constructor;
107 * For a *newtype*, the worker has a compulsory unfolding which
110 The worker for MkT has unfolding
111 \(x:Int). x `cast` sym CoT
112 Here CoT is the type constructor, witnessing the FC axiom
115 The "wrapper Id", $WC, goes as follows
117 * Its type is exactly what it looks like in the source program.
119 * It is an ordinary function, and it gets a top-level binding
120 like any other function.
122 * The wrapper Id isn't generated for a data type if there is
123 nothing for the wrapper to do. That is, if its defn would be
126 Why might the wrapper have anything to do? Two reasons:
128 * Unboxing strict fields (with -funbox-strict-fields)
129 data T = MkT !(Int,Int)
130 $wMkT :: (Int,Int) -> T
131 $wMkT (x,y) = MkT x y
132 Notice that the worker has two fields where the wapper has
133 just one. That is, the worker has type
134 MkT :: Int -> Int -> T
136 * Equality constraints for GADTs
137 data T a where { MkT :: a -> T [a] }
139 The worker gets a type with explicit equality
141 MkT :: forall a b. (a=[b]) => b -> T a
143 The wrapper has the programmer-specified type:
145 $wMkT a x = MkT [a] a [a] x
146 The third argument is a coerion
151 A note about the stupid context
152 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
153 Data types can have a context:
155 data (Eq a, Ord b) => T a b = T1 a b | T2 a
157 and that makes the constructors have a context too
158 (notice that T2's context is "thinned"):
160 T1 :: (Eq a, Ord b) => a -> b -> T a b
161 T2 :: (Eq a) => a -> T a b
163 Furthermore, this context pops up when pattern matching
164 (though GHC hasn't implemented this, but it is in H98, and
165 I've fixed GHC so that it now does):
169 f :: Eq a => T a b -> a
171 I say the context is "stupid" because the dictionaries passed
172 are immediately discarded -- they do nothing and have no benefit.
173 It's a flaw in the language.
175 Up to now [March 2002] I have put this stupid context into the
176 type of the "wrapper" constructors functions, T1 and T2, but
177 that turned out to be jolly inconvenient for generics, and
178 record update, and other functions that build values of type T
179 (because they don't have suitable dictionaries available).
181 So now I've taken the stupid context out. I simply deal with
182 it separately in the type checker on occurrences of a
183 constructor, either in an expression or in a pattern.
185 [May 2003: actually I think this decision could evasily be
186 reversed now, and probably should be. Generics could be
187 disabled for types with a stupid context; record updates now
188 (H98) needs the context too; etc. It's an unforced change, so
189 I'm leaving it for now --- but it does seem odd that the
190 wrapper doesn't include the stupid context.]
192 [July 04] With the advent of generalised data types, it's less obvious
193 what the "stupid context" is. Consider
194 C :: forall a. Ord a => a -> a -> T (Foo a)
195 Does the C constructor in Core contain the Ord dictionary? Yes, it must:
200 C a (d:Ord a) (p:a) (q:a) -> compare d p q
202 Note that (Foo a) might not be an instance of Ord.
204 %************************************************************************
206 \subsection{Data constructors}
208 %************************************************************************
213 dcName :: Name, -- This is the name of the *source data con*
214 -- (see "Note [Data Constructor Naming]" above)
215 dcUnique :: Unique, -- Cached from Name
220 -- *** As declared by the user
222 -- MkT :: forall x y. (Ord x) => x -> y -> T (x,y)
224 -- *** As represented internally
226 -- MkT :: forall a. forall x y. (a:=:(x,y), Ord x) => x -> y -> T a
228 -- The next six fields express the type of the constructor, in pieces
231 -- dcUnivTyVars = [a]
232 -- dcExTyVars = [x,y]
233 -- dcEqSpec = [a:=:(x,y)]
235 -- dcOrigArgTys = [a,List b]
238 dcVanilla :: Bool, -- True <=> This is a vanilla Haskell 98 data constructor
239 -- Its type is of form
240 -- forall a1..an . t1 -> ... tm -> T a1..an
241 -- No existentials, no coercions, nothing.
242 -- That is: dcExTyVars = dcEqSpec = dcTheta = []
243 -- NB 1: newtypes always have a vanilla data con
244 -- NB 2: a vanilla constructor can still be declared in GADT-style
245 -- syntax, provided its type looks like the above.
246 -- The declaration format is held in the TyCon (algTcGadtSyntax)
248 dcUnivTyVars :: [TyVar], -- Universally-quantified type vars
249 dcExTyVars :: [TyVar], -- Existentially-quantified type vars
250 -- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
251 -- FOR THE PARENT TyCon. With GADTs the data con might not even have
252 -- the same number of type variables.
253 -- [This is a change (Oct05): previously, vanilla datacons guaranteed to
254 -- have the same type variables as their parent TyCon, but that seems ugly.]
256 -- INVARIANT: the UnivTyVars and ExTyVars all have distinct OccNames
257 -- Reason: less confusing, and easier to generate IfaceSyn
259 dcEqSpec :: [(TyVar,Type)], -- Equalities derived from the result type,
260 -- *as written by the programmer*
261 -- This field allows us to move conveniently between the two ways
262 -- of representing a GADT constructor's type:
263 -- MkT :: forall a b. (a :=: [b]) => b -> T a
264 -- MkT :: forall b. b -> T [b]
265 -- Each equality is of the form (a :=: ty), where 'a' is one of
266 -- the universally quantified type variables
268 dcTheta :: ThetaType, -- The context of the constructor
269 -- In GADT form, this is *exactly* what the programmer writes, even if
270 -- the context constrains only universally quantified variables
271 -- MkT :: forall a. Eq a => a -> T a
272 -- It may contain user-written equality predicates too
274 dcStupidTheta :: ThetaType, -- The context of the data type declaration
275 -- data Eq a => T a = ...
276 -- or, rather, a "thinned" version thereof
277 -- "Thinned", because the Report says
278 -- to eliminate any constraints that don't mention
279 -- tyvars free in the arg types for this constructor
281 -- INVARIANT: the free tyvars of dcStupidTheta are a subset of dcUnivTyVars
282 -- Reason: dcStupidTeta is gotten by thinning the stupid theta from the tycon
284 -- "Stupid", because the dictionaries aren't used for anything.
285 -- Indeed, [as of March 02] they are no longer in the type of
286 -- the wrapper Id, because that makes it harder to use the wrap-id
287 -- to rebuild values after record selection or in generics.
289 dcOrigArgTys :: [Type], -- Original argument types
290 -- (before unboxing and flattening of strict fields)
292 -- Result type of constructor is T t1..tn
293 dcTyCon :: TyCon, -- Result tycon, T
295 -- Now the strictness annotations and field labels of the constructor
296 dcStrictMarks :: [StrictnessMark],
297 -- Strictness annotations as decided by the compiler.
298 -- Does *not* include the existential dictionaries
299 -- length = dataConSourceArity dataCon
301 dcFields :: [FieldLabel],
302 -- Field labels for this constructor, in the
303 -- same order as the argument types;
304 -- length = 0 (if not a record) or dataConSourceArity.
306 -- Constructor representation
307 dcRepArgTys :: [Type], -- Final, representation argument types,
308 -- after unboxing and flattening,
309 -- and *including* existential dictionaries
311 dcRepStrictness :: [StrictnessMark], -- One for each *representation* argument
313 dcRepType :: Type, -- Type of the constructor
314 -- forall a x y. (a:=:(x,y), Ord x) => x -> y -> MkT a
315 -- (this is *not* of the constructor wrapper Id:
316 -- see Note [Data con representation] below)
317 -- Notice that the existential type parameters come *second*.
318 -- Reason: in a case expression we may find:
319 -- case (e :: T t) of { MkT b (d:Ord b) (x:t) (xs:[b]) -> ... }
320 -- It's convenient to apply the rep-type of MkT to 't', to get
321 -- forall b. Ord b => ...
322 -- and use that to check the pattern. Mind you, this is really only
326 -- Finally, the curried worker function that corresponds to the constructor
327 -- It doesn't have an unfolding; the code generator saturates these Ids
328 -- and allocates a real constructor when it finds one.
330 -- An entirely separate wrapper function is built in TcTyDecls
333 dcInfix :: Bool -- True <=> declared infix
334 -- Used for Template Haskell and 'deriving' only
335 -- The actual fixity is stored elsewhere
339 = DCIds (Maybe Id) Id -- Algebraic data types always have a worker, and
340 -- may or may not have a wrapper, depending on whether
341 -- the wrapper does anything. Newtypes just have a worker
343 -- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments
345 -- The wrapper takes dcOrigArgTys as its arguments
346 -- The worker takes dcRepArgTys as its arguments
347 -- If the worker is absent, dcRepArgTys is the same as dcOrigArgTys
349 -- The 'Nothing' case of DCIds is important
350 -- Not only is this efficient,
351 -- but it also ensures that the wrapper is replaced
352 -- by the worker (becuase it *is* the wroker)
353 -- even when there are no args. E.g. in
355 -- the (:) *is* the worker.
356 -- This is really important in rule matching,
357 -- (We could match on the wrappers,
358 -- but that makes it less likely that rules will match
359 -- when we bring bits of unfoldings together.)
364 fIRST_TAG = 1 -- Tags allocated from here for real constructors
367 Note [Data con representation]
368 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
369 The dcRepType field contains the type of the representation of a contructor
370 This may differ from the type of the contructor *Id* (built
371 by MkId.mkDataConId) for two reasons:
372 a) the constructor Id may be overloaded, but the dictionary isn't stored
373 e.g. data Eq a => T a = MkT a a
375 b) the constructor may store an unboxed version of a strict field.
377 Here's an example illustrating both:
378 data Ord a => T a = MkT Int! a
380 T :: Ord a => Int -> a -> T a
382 Trep :: Int# -> a -> T a
383 Actually, the unboxed part isn't implemented yet!
386 %************************************************************************
388 \subsection{Instances}
390 %************************************************************************
393 instance Eq DataCon where
394 a == b = getUnique a == getUnique b
395 a /= b = getUnique a /= getUnique b
397 instance Ord DataCon where
398 a <= b = getUnique a <= getUnique b
399 a < b = getUnique a < getUnique b
400 a >= b = getUnique a >= getUnique b
401 a > b = getUnique a > getUnique b
402 compare a b = getUnique a `compare` getUnique b
404 instance Uniquable DataCon where
407 instance NamedThing DataCon where
410 instance Outputable DataCon where
411 ppr con = ppr (dataConName con)
413 instance Show DataCon where
414 showsPrec p con = showsPrecSDoc p (ppr con)
418 %************************************************************************
420 \subsection{Construction}
422 %************************************************************************
426 -> Bool -- Declared infix
427 -> [StrictnessMark] -> [FieldLabel]
428 -> [TyVar] -> [TyVar]
429 -> [(TyVar,Type)] -> ThetaType
431 -> ThetaType -> DataConIds
433 -- Can get the tag from the TyCon
435 mkDataCon name declared_infix
436 arg_stricts -- Must match orig_arg_tys 1-1
442 -- Warning: mkDataCon is not a good place to check invariants.
443 -- If the programmer writes the wrong result type in the decl, thus:
444 -- data T a where { MkT :: S }
445 -- then it's possible that the univ_tvs may hit an assertion failure
446 -- if you pull on univ_tvs. This case is checked by checkValidDataCon,
447 -- so the error is detected properly... it's just that asaertions here
448 -- are a little dodgy.
450 = ASSERT( not (any isEqPred theta) )
451 -- We don't currently allow any equality predicates on
452 -- a data constructor (apart from the GADT ones in eq_spec)
455 is_vanilla = null ex_tvs && null eq_spec && null theta
456 con = MkData {dcName = name, dcUnique = nameUnique name,
457 dcVanilla = is_vanilla, dcInfix = declared_infix,
458 dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
460 dcStupidTheta = stupid_theta, dcTheta = theta,
461 dcOrigArgTys = orig_arg_tys, dcTyCon = tycon,
462 dcRepArgTys = rep_arg_tys,
463 dcStrictMarks = arg_stricts,
464 dcRepStrictness = rep_arg_stricts,
465 dcFields = fields, dcTag = tag, dcRepType = ty,
468 -- Strictness marks for source-args
469 -- *after unboxing choices*,
470 -- but *including existential dictionaries*
472 -- The 'arg_stricts' passed to mkDataCon are simply those for the
473 -- source-language arguments. We add extra ones for the
474 -- dictionary arguments right here.
475 dict_tys = mkPredTys theta
476 real_arg_tys = dict_tys ++ orig_arg_tys
477 real_stricts = map mk_dict_strict_mark theta ++ arg_stricts
479 -- Representation arguments and demands
480 -- To do: eliminate duplication with MkId
481 (rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
483 tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
484 ty = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $
485 mkFunTys (mkPredTys (eqSpecPreds eq_spec)) $
486 -- NB: the dict args are already in rep_arg_tys
487 -- because they might be flattened..
488 -- but the equality predicates are not
489 mkFunTys rep_arg_tys $
490 mkTyConApp tycon (mkTyVarTys univ_tvs)
492 eqSpecPreds :: [(TyVar,Type)] -> ThetaType
493 eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv, ty) | (tv,ty) <- spec ]
495 mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
496 | otherwise = NotMarkedStrict
500 dataConName :: DataCon -> Name
503 dataConTag :: DataCon -> ConTag
506 dataConTyCon :: DataCon -> TyCon
507 dataConTyCon = dcTyCon
509 dataConRepType :: DataCon -> Type
510 dataConRepType = dcRepType
512 dataConIsInfix :: DataCon -> Bool
513 dataConIsInfix = dcInfix
515 dataConUnivTyVars :: DataCon -> [TyVar]
516 dataConUnivTyVars = dcUnivTyVars
518 dataConExTyVars :: DataCon -> [TyVar]
519 dataConExTyVars = dcExTyVars
521 dataConAllTyVars :: DataCon -> [TyVar]
522 dataConAllTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
525 dataConEqSpec :: DataCon -> [(TyVar,Type)]
526 dataConEqSpec = dcEqSpec
528 dataConTheta :: DataCon -> ThetaType
529 dataConTheta = dcTheta
531 dataConWorkId :: DataCon -> Id
532 dataConWorkId dc = case dcIds dc of
533 DCIds _ wrk_id -> wrk_id
535 dataConWrapId_maybe :: DataCon -> Maybe Id
536 -- Returns Nothing if there is no wrapper for an algebraic data con
537 -- and also for a newtype (whose constructor is inlined compulsorily)
538 dataConWrapId_maybe dc = case dcIds dc of
539 DCIds mb_wrap _ -> mb_wrap
541 dataConWrapId :: DataCon -> Id
542 -- Returns an Id which looks like the Haskell-source constructor
543 dataConWrapId dc = case dcIds dc of
544 DCIds (Just wrap) _ -> wrap
545 DCIds Nothing wrk -> wrk -- worker=wrapper
547 dataConImplicitIds :: DataCon -> [Id]
548 dataConImplicitIds dc = case dcIds dc of
549 DCIds (Just wrap) work -> [wrap,work]
550 DCIds Nothing work -> [work]
552 dataConFieldLabels :: DataCon -> [FieldLabel]
553 dataConFieldLabels = dcFields
555 dataConFieldType :: DataCon -> FieldLabel -> Type
556 dataConFieldType con label = expectJust "unexpected label" $
557 lookup label (dcFields con `zip` dcOrigArgTys con)
559 dataConStrictMarks :: DataCon -> [StrictnessMark]
560 dataConStrictMarks = dcStrictMarks
562 dataConExStricts :: DataCon -> [StrictnessMark]
563 -- Strictness of *existential* arguments only
564 -- Usually empty, so we don't bother to cache this
565 dataConExStricts dc = map mk_dict_strict_mark (dcTheta dc)
567 dataConSourceArity :: DataCon -> Arity
568 -- Source-level arity of the data constructor
569 dataConSourceArity dc = length (dcOrigArgTys dc)
571 -- dataConRepArity gives the number of actual fields in the
572 -- {\em representation} of the data constructor. This may be more than appear
573 -- in the source code; the extra ones are the existentially quantified
575 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
577 isNullarySrcDataCon, isNullaryRepDataCon :: DataCon -> Bool
578 isNullarySrcDataCon dc = null (dcOrigArgTys dc)
579 isNullaryRepDataCon dc = null (dcRepArgTys dc)
581 dataConRepStrictness :: DataCon -> [StrictnessMark]
582 -- Give the demands on the arguments of a
583 -- Core constructor application (Con dc args)
584 dataConRepStrictness dc = dcRepStrictness dc
586 dataConSig :: DataCon -> ([TyVar], ThetaType, [Type])
587 dataConSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
588 dcTheta = theta, dcOrigArgTys = arg_tys, dcTyCon = tycon})
589 = (univ_tvs ++ ex_tvs, eqSpecPreds eq_spec ++ theta, arg_tys)
591 dataConFullSig :: DataCon
592 -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, [Type])
593 dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
594 dcTheta = theta, dcOrigArgTys = arg_tys, dcTyCon = tycon})
595 = (univ_tvs, ex_tvs, eq_spec, theta, arg_tys)
597 dataConStupidTheta :: DataCon -> ThetaType
598 dataConStupidTheta dc = dcStupidTheta dc
600 dataConResTys :: DataCon -> [Type]
601 dataConResTys dc = [substTyVar env tv | tv <- dcUnivTyVars dc]
603 env = mkTopTvSubst (dcEqSpec dc)
605 dataConUserType :: DataCon -> Type
606 -- The user-declared type of the data constructor
607 -- in the nice-to-read form
608 -- T :: forall a. a -> T [a]
610 -- T :: forall b. forall a. (a=[b]) => a -> T b
611 -- NB: If the constructor is part of a data instance, the result type
612 -- mentions the family tycon, not the internal one.
613 dataConUserType (MkData { dcUnivTyVars = univ_tvs,
614 dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
615 dcTheta = theta, dcOrigArgTys = arg_tys,
617 = mkForAllTys ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs) $
618 mkFunTys (mkPredTys theta) $
620 case tyConFamInst_maybe tycon of
621 Nothing -> mkTyConApp tycon (map (substTyVar subst) univ_tvs)
622 Just (ftc, insttys) -> mkTyConApp ftc insttys -- data instance
624 subst = mkTopTvSubst eq_spec
626 dataConInstArgTys :: DataCon
627 -> [Type] -- Instantiated at these types
628 -- NB: these INCLUDE the existentially quantified arg types
629 -> [Type] -- Needs arguments of these types
630 -- NB: these INCLUDE the existentially quantified dict args
631 -- but EXCLUDE the data-decl context which is discarded
632 -- It's all post-flattening etc; this is a representation type
633 dataConInstArgTys (MkData {dcRepArgTys = arg_tys,
634 dcUnivTyVars = univ_tvs,
635 dcExTyVars = ex_tvs}) inst_tys
636 = ASSERT( length tyvars == length inst_tys )
637 map (substTyWith tyvars inst_tys) arg_tys
639 tyvars = univ_tvs ++ ex_tvs
642 -- And the same deal for the original arg tys
643 dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
644 dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
645 dcUnivTyVars = univ_tvs,
646 dcExTyVars = ex_tvs}) inst_tys
647 = ASSERT2( length tyvars == length inst_tys, ptext SLIT("dataConInstOrigArgTys") <+> ppr dc <+> ppr inst_tys )
648 map (substTyWith tyvars inst_tys) arg_tys
650 tyvars = univ_tvs ++ ex_tvs
653 These two functions get the real argument types of the constructor,
654 without substituting for any type variables.
656 dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
658 dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
659 after any flattening has been done.
662 dataConOrigArgTys :: DataCon -> [Type]
663 dataConOrigArgTys dc = dcOrigArgTys dc
665 dataConRepArgTys :: DataCon -> [Type]
666 dataConRepArgTys dc = dcRepArgTys dc
671 isTupleCon :: DataCon -> Bool
672 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
674 isUnboxedTupleCon :: DataCon -> Bool
675 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
677 isVanillaDataCon :: DataCon -> Bool
678 isVanillaDataCon dc = dcVanilla dc
683 classDataCon :: Class -> DataCon
684 classDataCon clas = case tyConDataCons (classTyCon clas) of
685 (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
688 %************************************************************************
690 \subsection{Splitting products}
692 %************************************************************************
695 splitProductType_maybe
696 :: Type -- A product type, perhaps
697 -> Maybe (TyCon, -- The type constructor
698 [Type], -- Type args of the tycon
699 DataCon, -- The data constructor
700 [Type]) -- Its *representation* arg types
702 -- Returns (Just ...) for any
703 -- concrete (i.e. constructors visible)
704 -- single-constructor
705 -- not existentially quantified
706 -- type whether a data type or a new type
708 -- Rejecing existentials is conservative. Maybe some things
709 -- could be made to work with them, but I'm not going to sweat
710 -- it through till someone finds it's important.
712 splitProductType_maybe ty
713 = case splitTyConApp_maybe ty of
715 | isProductTyCon tycon -- Includes check for non-existential,
716 -- and for constructors visible
717 -> Just (tycon, ty_args, data_con, dataConInstArgTys data_con ty_args)
719 data_con = head (tyConDataCons tycon)
722 splitProductType str ty
723 = case splitProductType_maybe ty of
725 Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
728 deepSplitProductType_maybe ty
729 = do { (res@(tycon, tycon_args, _, _)) <- splitProductType_maybe ty
731 | isClosedNewTyCon tycon && not (isRecursiveTyCon tycon)
732 = deepSplitProductType_maybe (newTyConInstRhs tycon tycon_args)
733 | isNewTyCon tycon = Nothing -- cannot unbox through recursive
734 -- newtypes nor through families
735 | otherwise = Just res}
739 deepSplitProductType str ty
740 = case deepSplitProductType_maybe ty of
742 Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
744 computeRep :: [StrictnessMark] -- Original arg strictness
745 -> [Type] -- and types
746 -> ([StrictnessMark], -- Representation arg strictness
749 computeRep stricts tys
750 = unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
752 unbox NotMarkedStrict ty = [(NotMarkedStrict, ty)]
753 unbox MarkedStrict ty = [(MarkedStrict, ty)]
754 unbox MarkedUnboxed ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
756 (_tycon, _tycon_args, arg_dc, arg_tys)
757 = deepSplitProductType "unbox_strict_arg_ty" ty