compiler/basicTypes/DataCon.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
   3 %
   4 \section[DataCon]{@DataCon@: Data Constructors}
   5
   6 \begin{code}
   7 module DataCon (
   8         DataCon, DataConIds(..),
   9         ConTag, fIRST_TAG,
  10         mkDataCon,
  11         dataConRepType, dataConSig, dataConName, dataConTag, dataConTyCon,
  12         dataConTyVars, dataConResTys,
  13         dataConStupidTheta,
  14         dataConInstArgTys, dataConOrigArgTys, dataConInstResTy,
  15         dataConInstOrigArgTys, dataConRepArgTys,
  16         dataConFieldLabels, dataConFieldType,
  17         dataConStrictMarks, dataConExStricts,
  18         dataConSourceArity, dataConRepArity,
  19         dataConIsInfix,
  20         dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds,
  21         dataConRepStrictness,
  22         isNullarySrcDataCon, isNullaryRepDataCon, isTupleCon, isUnboxedTupleCon,
  23         isVanillaDataCon, classDataCon,
  24
  25         splitProductType_maybe, splitProductType,
  26     ) where
  27
  28 #include "HsVersions.h"
  29
  30 import Type             ( Type, ThetaType, substTyWith, substTy, zipOpenTvSubst,
  31                           mkForAllTys, mkFunTys, mkTyConApp,
  32                           splitTyConApp_maybe,
  33                           mkPredTys, isStrictPred, pprType
  34                         )
  35 import TyCon            ( TyCon, FieldLabel, tyConDataCons,
  36                           isProductTyCon, isTupleTyCon, isUnboxedTupleTyCon )
  37 import Class            ( Class, classTyCon )
  38 import Name             ( Name, NamedThing(..), nameUnique )
  39 import Var              ( TyVar, Id )
  40 import BasicTypes       ( Arity, StrictnessMark(..) )
  41 import Outputable
  42 import Unique           ( Unique, Uniquable(..) )
  43 import ListSetOps       ( assoc )
  44 import Util             ( zipEqual, zipWithEqual )
  45 import Maybes           ( expectJust )
  46 \end{code}
  47
  48
  49 Data constructor representation
  50 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  51 Consider the following Haskell data type declaration
  52
  53         data T = T !Int ![Int]
  54
  55 Using the strictness annotations, GHC will represent this as
  56
  57         data T = T Int# [Int]
  58
  59 That is, the Int has been unboxed.  Furthermore, the Haskell source construction
  60
  61         T e1 e2
  62
  63 is translated to
  64
  65         case e1 of { I# x ->
  66         case e2 of { r ->
  67         T x r }}
  68
  69 That is, the first argument is unboxed, and the second is evaluated.  Finally,
  70 pattern matching is translated too:
  71
  72         case e of { T a b -> ... }
  73
  74 becomes
  75
  76         case e of { T a' b -> let a = I# a' in ... }
  77
  78 To keep ourselves sane, we name the different versions of the data constructor
  79 differently, as follows.
  80
  81
  82 Note [Data Constructor Naming]
  83 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  84 Each data constructor C has two, and possibly three, Names associated with it:
  85
  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)
  91
  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).
  96
  97 The data con has one or two Ids associated with it:
  98
  99   The "worker Id", is the actual data constructor.
 100         Its type may be different to the Haskell source constructor
 101         because:
 102                 - useless dict args are dropped
 103                 - strict args may be flattened
 104         The worker is very like a primop, in that it has no binding.
 105
 106         Newtypes have no worker Id
 107
 108
 109   The "wrapper Id", $WC, whose type is exactly what it looks like
 110         in the source program. It is an ordinary function,
 111         and it gets a top-level binding like any other function.
 112
 113         The wrapper Id isn't generated for a data type if the worker
 114         and wrapper are identical.  It's always generated for a newtype.
 115
 116
 117
 118 A note about the stupid context
 119 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 120 Data types can have a context:
 121
 122         data (Eq a, Ord b) => T a b = T1 a b | T2 a
 123
 124 and that makes the constructors have a context too
 125 (notice that T2's context is "thinned"):
 126
 127         T1 :: (Eq a, Ord b) => a -> b -> T a b
 128         T2 :: (Eq a) => a -> T a b
 129
 130 Furthermore, this context pops up when pattern matching
 131 (though GHC hasn't implemented this, but it is in H98, and
 132 I've fixed GHC so that it now does):
 133
 134         f (T2 x) = x
 135 gets inferred type
 136         f :: Eq a => T a b -> a
 137
 138 I say the context is "stupid" because the dictionaries passed
 139 are immediately discarded -- they do nothing and have no benefit.
 140 It's a flaw in the language.
 141
 142         Up to now [March 2002] I have put this stupid context into the
 143         type of the "wrapper" constructors functions, T1 and T2, but
 144         that turned out to be jolly inconvenient for generics, and
 145         record update, and other functions that build values of type T
 146         (because they don't have suitable dictionaries available).
 147
 148         So now I've taken the stupid context out.  I simply deal with
 149         it separately in the type checker on occurrences of a
 150         constructor, either in an expression or in a pattern.
 151
 152         [May 2003: actually I think this decision could evasily be
 153         reversed now, and probably should be.  Generics could be
 154         disabled for types with a stupid context; record updates now
 155         (H98) needs the context too; etc.  It's an unforced change, so
 156         I'm leaving it for now --- but it does seem odd that the
 157         wrapper doesn't include the stupid context.]
 158
 159 [July 04] With the advent of generalised data types, it's less obvious
 160 what the "stupid context" is.  Consider
 161         C :: forall a. Ord a => a -> a -> T (Foo a)
 162 Does the C constructor in Core contain the Ord dictionary?  Yes, it must:
 163
 164         f :: T b -> Ordering
 165         f = /\b. \x:T b.
 166             case x of
 167                 C a (d:Ord a) (p:a) (q:a) -> compare d p q
 168
 169 Note that (Foo a) might not be an instance of Ord.
 170
 171 %************************************************************************
 172 %*                                                                      *
 173 \subsection{Data constructors}
 174 %*                                                                      *
 175 %************************************************************************
 176
 177 \begin{code}
 178 data DataCon
 179   = MkData {
 180         dcName    :: Name,      -- This is the name of the *source data con*
 181                                 -- (see "Note [Data Constructor Naming]" above)
 182         dcUnique :: Unique,     -- Cached from Name
 183         dcTag    :: ConTag,
 184
 185         -- Running example:
 186         --
 187         --      data Eq a => T a = forall b. Ord b => MkT a [b]
 188
 189         -- The next six fields express the type of the constructor, in pieces
 190         -- e.g.
 191         --
 192         --      dcTyVars      = [a,b]
 193         --      dcStupidTheta = [Eq a]
 194         --      dcTheta       = [Ord b]
 195         --      dcOrigArgTys  = [a,List b]
 196         --      dcTyCon       = T
 197         --      dcTyArgs      = [a,b]
 198
 199         dcVanilla :: Bool,      -- True <=> This is a vanilla Haskell 98 data constructor
 200                                 --          Its type is of form
 201                                 --              forall a1..an . t1 -> ... tm -> T a1..an
 202                                 --          No existentials, no GADTs, nothing.
 203                                 --
 204                                 -- NB1: the order of the forall'd variables does matter;
 205                                 --      for a vanilla constructor, we assume that if the result
 206                                 --      type is (T t1 ... tn) then we can instantiate the constr
 207                                 --      at types [t1, ..., tn]
 208                                 --
 209                                 -- NB2: a vanilla constructor can still be declared in GADT-style
 210                                 --      syntax, provided its type looks like the above.
 211
 212         dcTyVars :: [TyVar],    -- Universally-quantified type vars
 213                                 -- for the data constructor.
 214                 -- See NB1 on dcVanilla for the conneciton between dcTyVars and dcResTys
 215                 --
 216                 -- In general, the dcTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
 217                 -- FOR THE PARENT TyCon. With GADTs the data con might not even have
 218                 -- the same number of type variables.
 219                 -- [This is a change (Oct05): previously, vanilla datacons guaranteed to
 220                 --  have the same type variables as their parent TyCon, but that seems ugly.]
 221
 222         dcStupidTheta  ::  ThetaType,   -- This is a "thinned" version of
 223                                         -- the context of the data decl.
 224                 -- "Thinned", because the Report says
 225                 -- to eliminate any constraints that don't mention
 226                 -- tyvars free in the arg types for this constructor
 227                 --
 228                 -- "Stupid", because the dictionaries aren't used for anything.
 229                 --
 230                 -- Indeed, [as of March 02] they are no
 231                 -- longer in the type of the wrapper Id, because
 232                 -- that makes it harder to use the wrap-id to rebuild
 233                 -- values after record selection or in generics.
 234                 --
 235                 -- Fact: the free tyvars of dcStupidTheta are a subset of
 236                 --       the free tyvars of dcResTys
 237                 -- Reason: dcStupidTeta is gotten by instantiating the
 238                 --         stupid theta from the tycon (see BuildTyCl.mkDataConStupidTheta)
 239
 240         dcTheta  :: ThetaType,          -- The existentially quantified stuff
 241
 242         dcOrigArgTys :: [Type],         -- Original argument types
 243                                         -- (before unboxing and flattening of
 244                                         --  strict fields)
 245
 246         -- Result type of constructor is T t1..tn
 247         dcTyCon  :: TyCon,              -- Result tycon, T
 248         dcResTys :: [Type],             -- Result type args, t1..tn
 249
 250         -- Now the strictness annotations and field labels of the constructor
 251         dcStrictMarks :: [StrictnessMark],
 252                 -- Strictness annotations as decided by the compiler.
 253                 -- Does *not* include the existential dictionaries
 254                 -- length = dataConSourceArity dataCon
 255
 256         dcFields  :: [FieldLabel],
 257                 -- Field labels for this constructor, in the
 258                 -- same order as the argument types;
 259                 -- length = 0 (if not a record) or dataConSourceArity.
 260
 261         -- Constructor representation
 262         dcRepArgTys :: [Type],          -- Final, representation argument types,
 263                                         -- after unboxing and flattening,
 264                                         -- and *including* existential dictionaries
 265
 266         dcRepStrictness :: [StrictnessMark],    -- One for each *representation* argument
 267
 268         dcRepType   :: Type,    -- Type of the constructor
 269                                 --      forall a b . Ord b => a -> [b] -> MkT a
 270                                 -- (this is *not* of the constructor wrapper Id:
 271                                 --  see notes after this data type declaration)
 272                                 --
 273         -- Notice that the existential type parameters come *second*.
 274         -- Reason: in a case expression we may find:
 275         --      case (e :: T t) of { MkT b (d:Ord b) (x:t) (xs:[b]) -> ... }
 276         -- It's convenient to apply the rep-type of MkT to 't', to get
 277         --      forall b. Ord b => ...
 278         -- and use that to check the pattern.  Mind you, this is really only
 279         -- use in CoreLint.
 280
 281
 282         -- Finally, the curried worker function that corresponds to the constructor
 283         -- It doesn't have an unfolding; the code generator saturates these Ids
 284         -- and allocates a real constructor when it finds one.
 285         --
 286         -- An entirely separate wrapper function is built in TcTyDecls
 287         dcIds :: DataConIds,
 288
 289         dcInfix :: Bool         -- True <=> declared infix
 290                                 -- Used for Template Haskell and 'deriving' only
 291                                 -- The actual fixity is stored elsewhere
 292   }
 293
 294 data DataConIds
 295   = NewDC Id                    -- Newtypes have only a wrapper, but no worker
 296   | AlgDC (Maybe Id) Id         -- Algebraic data types always have a worker, and
 297                                 -- may or may not have a wrapper, depending on whether
 298                                 -- the wrapper does anything.
 299
 300         -- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments
 301
 302         -- The wrapper takes dcOrigArgTys as its arguments
 303         -- The worker takes dcRepArgTys as its arguments
 304         -- If the worker is absent, dcRepArgTys is the same as dcOrigArgTys
 305
 306         -- The 'Nothing' case of AlgDC is important
 307         -- Not only is this efficient,
 308         -- but it also ensures that the wrapper is replaced
 309         -- by the worker (becuase it *is* the wroker)
 310         -- even when there are no args. E.g. in
 311         --              f (:) x
 312         -- the (:) *is* the worker.
 313         -- This is really important in rule matching,
 314         -- (We could match on the wrappers,
 315         -- but that makes it less likely that rules will match
 316         -- when we bring bits of unfoldings together.)
 317
 318 type ConTag = Int
 319
 320 fIRST_TAG :: ConTag
 321 fIRST_TAG =  1  -- Tags allocated from here for real constructors
 322 \end{code}
 323
 324 The dcRepType field contains the type of the representation of a contructor
 325 This may differ from the type of the contructor *Id* (built
 326 by MkId.mkDataConId) for two reasons:
 327         a) the constructor Id may be overloaded, but the dictionary isn't stored
 328            e.g.    data Eq a => T a = MkT a a
 329
 330         b) the constructor may store an unboxed version of a strict field.
 331
 332 Here's an example illustrating both:
 333         data Ord a => T a = MkT Int! a
 334 Here
 335         T :: Ord a => Int -> a -> T a
 336 but the rep type is
 337         Trep :: Int# -> a -> T a
 338 Actually, the unboxed part isn't implemented yet!
 339
 340
 341 %************************************************************************
 342 %*                                                                      *
 343 \subsection{Instances}
 344 %*                                                                      *
 345 %************************************************************************
 346
 347 \begin{code}
 348 instance Eq DataCon where
 349     a == b = getUnique a == getUnique b
 350     a /= b = getUnique a /= getUnique b
 351
 352 instance Ord DataCon where
 353     a <= b = getUnique a <= getUnique b
 354     a <  b = getUnique a <  getUnique b
 355     a >= b = getUnique a >= getUnique b
 356     a >  b = getUnique a > getUnique b
 357     compare a b = getUnique a `compare` getUnique b
 358
 359 instance Uniquable DataCon where
 360     getUnique = dcUnique
 361
 362 instance NamedThing DataCon where
 363     getName = dcName
 364
 365 instance Outputable DataCon where
 366     ppr con = ppr (dataConName con)
 367
 368 instance Show DataCon where
 369     showsPrec p con = showsPrecSDoc p (ppr con)
 370 \end{code}
 371
 372
 373 %************************************************************************
 374 %*                                                                      *
 375 \subsection{Construction}
 376 %*                                                                      *
 377 %************************************************************************
 378
 379 \begin{code}
 380 mkDataCon :: Name
 381           -> Bool       -- Declared infix
 382           -> Bool       -- Vanilla (see notes with dcVanilla)
 383           -> [StrictnessMark] -> [FieldLabel]
 384           -> [TyVar] -> ThetaType -> ThetaType
 385           -> [Type] -> TyCon -> [Type]
 386           -> DataConIds
 387           -> DataCon
 388   -- Can get the tag from the TyCon
 389
 390 mkDataCon name declared_infix vanilla
 391           arg_stricts   -- Must match orig_arg_tys 1-1
 392           fields
 393           tyvars stupid_theta theta orig_arg_tys tycon res_tys
 394           ids
 395   = con
 396   where
 397     con = MkData {dcName = name,
 398                   dcUnique = nameUnique name, dcVanilla = vanilla,
 399                   dcTyVars = tyvars, dcStupidTheta = stupid_theta, dcTheta = theta,
 400                   dcOrigArgTys = orig_arg_tys, dcTyCon = tycon, dcResTys = res_tys,
 401                   dcRepArgTys = rep_arg_tys,
 402                   dcStrictMarks = arg_stricts, dcRepStrictness = rep_arg_stricts,
 403                   dcFields = fields, dcTag = tag, dcRepType = ty,
 404                   dcIds = ids, dcInfix = declared_infix}
 405
 406         -- Strictness marks for source-args
 407         --      *after unboxing choices*,
 408         -- but  *including existential dictionaries*
 409         --
 410         -- The 'arg_stricts' passed to mkDataCon are simply those for the
 411         -- source-language arguments.  We add extra ones for the
 412         -- dictionary arguments right here.
 413     dict_tys     = mkPredTys theta
 414     real_arg_tys = dict_tys                      ++ orig_arg_tys
 415     real_stricts = map mk_dict_strict_mark theta ++ arg_stricts
 416
 417         -- Representation arguments and demands
 418     (rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
 419
 420     tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
 421     ty  = mkForAllTys tyvars (mkFunTys rep_arg_tys result_ty)
 422                 -- NB: the existential dict args are already in rep_arg_tys
 423
 424     result_ty = mkTyConApp tycon res_tys
 425
 426 mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
 427                          | otherwise         = NotMarkedStrict
 428 \end{code}
 429
 430 \begin{code}
 431 dataConName :: DataCon -> Name
 432 dataConName = dcName
 433
 434 dataConTag :: DataCon -> ConTag
 435 dataConTag  = dcTag
 436
 437 dataConTyCon :: DataCon -> TyCon
 438 dataConTyCon = dcTyCon
 439
 440 dataConRepType :: DataCon -> Type
 441 dataConRepType = dcRepType
 442
 443 dataConIsInfix :: DataCon -> Bool
 444 dataConIsInfix = dcInfix
 445
 446 dataConTyVars :: DataCon -> [TyVar]
 447 dataConTyVars = dcTyVars
 448
 449 dataConWorkId :: DataCon -> Id
 450 dataConWorkId dc = case dcIds dc of
 451                         AlgDC _ wrk_id -> wrk_id
 452                         NewDC _ -> pprPanic "dataConWorkId" (ppr dc)
 453
 454 dataConWrapId_maybe :: DataCon -> Maybe Id
 455 -- Returns Nothing if there is no wrapper for an algebraic data con
 456 --                 and also for a newtype (whose constructor is inlined compulsorily)
 457 dataConWrapId_maybe dc = case dcIds dc of
 458                                 AlgDC mb_wrap _ -> mb_wrap
 459                                 NewDC wrap      -> Nothing
 460
 461 dataConWrapId :: DataCon -> Id
 462 -- Returns an Id which looks like the Haskell-source constructor
 463 dataConWrapId dc = case dcIds dc of
 464                         AlgDC (Just wrap) _   -> wrap
 465                         AlgDC Nothing     wrk -> wrk        -- worker=wrapper
 466                         NewDC wrap            -> wrap
 467
 468 dataConImplicitIds :: DataCon -> [Id]
 469 dataConImplicitIds dc = case dcIds dc of
 470                           AlgDC (Just wrap) work -> [wrap,work]
 471                           AlgDC Nothing     work -> [work]
 472                           NewDC wrap             -> [wrap]
 473
 474 dataConFieldLabels :: DataCon -> [FieldLabel]
 475 dataConFieldLabels = dcFields
 476
 477 dataConFieldType :: DataCon -> FieldLabel -> Type
 478 dataConFieldType con label = expectJust "unexpected label" $
 479     lookup label (dcFields con `zip` dcOrigArgTys con)
 480
 481 dataConStrictMarks :: DataCon -> [StrictnessMark]
 482 dataConStrictMarks = dcStrictMarks
 483
 484 dataConExStricts :: DataCon -> [StrictnessMark]
 485 -- Strictness of *existential* arguments only
 486 -- Usually empty, so we don't bother to cache this
 487 dataConExStricts dc = map mk_dict_strict_mark (dcTheta dc)
 488
 489 dataConSourceArity :: DataCon -> Arity
 490         -- Source-level arity of the data constructor
 491 dataConSourceArity dc = length (dcOrigArgTys dc)
 492
 493 -- dataConRepArity gives the number of actual fields in the
 494 -- {\em representation} of the data constructor.  This may be more than appear
 495 -- in the source code; the extra ones are the existentially quantified
 496 -- dictionaries
 497 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
 498
 499 isNullarySrcDataCon, isNullaryRepDataCon :: DataCon -> Bool
 500 isNullarySrcDataCon dc = null (dcOrigArgTys dc)
 501 isNullaryRepDataCon dc = null (dcRepArgTys dc)
 502
 503 dataConRepStrictness :: DataCon -> [StrictnessMark]
 504         -- Give the demands on the arguments of a
 505         -- Core constructor application (Con dc args)
 506 dataConRepStrictness dc = dcRepStrictness dc
 507
 508 dataConSig :: DataCon -> ([TyVar], ThetaType,
 509                           [Type], TyCon, [Type])
 510
 511 dataConSig (MkData {dcTyVars = tyvars, dcTheta  = theta,
 512                     dcOrigArgTys = arg_tys, dcTyCon = tycon, dcResTys = res_tys})
 513   = (tyvars, theta, arg_tys, tycon, res_tys)
 514
 515 dataConStupidTheta :: DataCon -> ThetaType
 516 dataConStupidTheta dc = dcStupidTheta dc
 517
 518 dataConResTys :: DataCon -> [Type]
 519 dataConResTys dc = dcResTys dc
 520
 521 dataConInstArgTys :: DataCon
 522                   -> [Type]     -- Instantiated at these types
 523                                 -- NB: these INCLUDE the existentially quantified arg types
 524                   -> [Type]     -- Needs arguments of these types
 525                                 -- NB: these INCLUDE the existentially quantified dict args
 526                                 --     but EXCLUDE the data-decl context which is discarded
 527                                 -- It's all post-flattening etc; this is a representation type
 528 dataConInstArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars}) inst_tys
 529  = ASSERT( length tyvars == length inst_tys )
 530    map (substTyWith tyvars inst_tys) arg_tys
 531
 532 dataConInstResTy :: DataCon -> [Type] -> Type
 533 dataConInstResTy (MkData {dcTyVars = tyvars, dcTyCon = tc, dcResTys = res_tys}) inst_tys
 534  = ASSERT( length tyvars == length inst_tys )
 535    substTy (zipOpenTvSubst tyvars inst_tys) (mkTyConApp tc res_tys)
 536         -- res_tys can't currently contain any foralls,
 537         -- but might in future; hence zipOpenTvSubst
 538
 539 -- And the same deal for the original arg tys
 540 dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
 541 dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars}) inst_tys
 542  = ASSERT( length tyvars == length inst_tys )
 543    map (substTyWith tyvars inst_tys) arg_tys
 544 \end{code}
 545
 546 These two functions get the real argument types of the constructor,
 547 without substituting for any type variables.
 548
 549 dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
 550
 551 dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
 552 after any flattening has been done.
 553
 554 \begin{code}
 555 dataConOrigArgTys :: DataCon -> [Type]
 556 dataConOrigArgTys dc = dcOrigArgTys dc
 557
 558 dataConRepArgTys :: DataCon -> [Type]
 559 dataConRepArgTys dc = dcRepArgTys dc
 560 \end{code}
 561
 562
 563 \begin{code}
 564 isTupleCon :: DataCon -> Bool
 565 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
 566
 567 isUnboxedTupleCon :: DataCon -> Bool
 568 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
 569
 570 isVanillaDataCon :: DataCon -> Bool
 571 isVanillaDataCon dc = dcVanilla dc
 572 \end{code}
 573
 574
 575 \begin{code}
 576 classDataCon :: Class -> DataCon
 577 classDataCon clas = case tyConDataCons (classTyCon clas) of
 578                       (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
 579 \end{code}
 580
 581 %************************************************************************
 582 %*                                                                      *
 583 \subsection{Splitting products}
 584 %*                                                                      *
 585 %************************************************************************
 586
 587 \begin{code}
 588 splitProductType_maybe
 589         :: Type                         -- A product type, perhaps
 590         -> Maybe (TyCon,                -- The type constructor
 591                   [Type],               -- Type args of the tycon
 592                   DataCon,              -- The data constructor
 593                   [Type])               -- Its *representation* arg types
 594
 595         -- Returns (Just ...) for any
 596         --      concrete (i.e. constructors visible)
 597         --      single-constructor
 598         --      not existentially quantified
 599         -- type whether a data type or a new type
 600         --
 601         -- Rejecing existentials is conservative.  Maybe some things
 602         -- could be made to work with them, but I'm not going to sweat
 603         -- it through till someone finds it's important.
 604
 605 splitProductType_maybe ty
 606   = case splitTyConApp_maybe ty of
 607         Just (tycon,ty_args)
 608            | isProductTyCon tycon       -- Includes check for non-existential,
 609                                         -- and for constructors visible
 610            -> Just (tycon, ty_args, data_con, dataConInstArgTys data_con ty_args)
 611            where
 612               data_con = head (tyConDataCons tycon)
 613         other -> Nothing
 614
 615 splitProductType str ty
 616   = case splitProductType_maybe ty of
 617         Just stuff -> stuff
 618         Nothing    -> pprPanic (str ++ ": not a product") (pprType ty)
 619
 620
 621 computeRep :: [StrictnessMark]          -- Original arg strictness
 622            -> [Type]                    -- and types
 623            -> ([StrictnessMark],        -- Representation arg strictness
 624                [Type])                  -- And type
 625
 626 computeRep stricts tys
 627   = unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
 628   where
 629     unbox NotMarkedStrict ty = [(NotMarkedStrict, ty)]
 630     unbox MarkedStrict    ty = [(MarkedStrict,    ty)]
 631     unbox MarkedUnboxed   ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
 632                              where
 633                                (_, _, arg_dc, arg_tys) = splitProductType "unbox_strict_arg_ty" ty
 634 \end{code}