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, 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,
  20         dataConIsInfix,
  21         dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds,
  22         dataConRepStrictness,
  23         isNullarySrcDataCon, isNullaryRepDataCon, isTupleCon, isUnboxedTupleCon,
  24         isVanillaDataCon, classDataCon,
  25
  26         splitProductType_maybe, splitProductType, deepSplitProductType,
  27         deepSplitProductType_maybe
  28     ) where
  29
  30 #include "HsVersions.h"
  31
  32 import Type             ( Type, ThetaType,
  33                           substTyWith, substTyVar, mkTopTvSubst,
  34                           mkForAllTys, mkFunTys, mkTyConApp, mkTyVarTy, mkTyVarTys,
  35                           splitTyConApp_maybe, newTyConInstRhs,
  36                           mkPredTys, isStrictPred, pprType
  37                         )
  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(..) )
  46 import Outputable
  47 import Unique           ( Unique, Uniquable(..) )
  48 import ListSetOps       ( assoc, minusList )
  49 import Util             ( zipEqual, zipWithEqual )
  50 import List             ( partition )
  51 import Maybes           ( expectJust )
  52 \end{code}
  53
  54
  55 Data constructor representation
  56 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  57 Consider the following Haskell data type declaration
  58
  59         data T = T !Int ![Int]
  60
  61 Using the strictness annotations, GHC will represent this as
  62
  63         data T = T Int# [Int]
  64
  65 That is, the Int has been unboxed.  Furthermore, the Haskell source construction
  66
  67         T e1 e2
  68
  69 is translated to
  70
  71         case e1 of { I# x ->
  72         case e2 of { r ->
  73         T x r }}
  74
  75 That is, the first argument is unboxed, and the second is evaluated.  Finally,
  76 pattern matching is translated too:
  77
  78         case e of { T a b -> ... }
  79
  80 becomes
  81
  82         case e of { T a' b -> let a = I# a' in ... }
  83
  84 To keep ourselves sane, we name the different versions of the data constructor
  85 differently, as follows.
  86
  87
  88 Note [Data Constructor Naming]
  89 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  90 Each data constructor C has two, and possibly three, Names associated with it:
  91
  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)
  97
  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).
 102
 103 The data con has one or two Ids associated with it:
 104
 105   The "worker Id", is the actual data constructor.
 106         Its type may be different to the Haskell source constructor
 107         because:
 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.
 111
 112         Newtypes have no worker Id
 113
 114
 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.
 118
 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.
 121
 122
 123
 124 A note about the stupid context
 125 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 126 Data types can have a context:
 127
 128         data (Eq a, Ord b) => T a b = T1 a b | T2 a
 129
 130 and that makes the constructors have a context too
 131 (notice that T2's context is "thinned"):
 132
 133         T1 :: (Eq a, Ord b) => a -> b -> T a b
 134         T2 :: (Eq a) => a -> T a b
 135
 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):
 139
 140         f (T2 x) = x
 141 gets inferred type
 142         f :: Eq a => T a b -> a
 143
 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.
 147
 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).
 153
 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.
 157
 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.]
 164
 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:
 169
 170         f :: T b -> Ordering
 171         f = /\b. \x:T b.
 172             case x of
 173                 C a (d:Ord a) (p:a) (q:a) -> compare d p q
 174
 175 Note that (Foo a) might not be an instance of Ord.
 176
 177 %************************************************************************
 178 %*                                                                      *
 179 \subsection{Data constructors}
 180 %*                                                                      *
 181 %************************************************************************
 182
 183 \begin{code}
 184 data DataCon
 185   = MkData {
 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
 189         dcTag    :: ConTag,
 190
 191         -- Running example:
 192         --
 193         --      *** As declared by the user
 194         --  data T a where
 195         --    MkT :: forall x y. (Ord x) => x -> y -> T (x,y)
 196
 197         --      *** As represented internally
 198         --  data T a where
 199         --    MkT :: forall a. forall x y. (a:=:(x,y), Ord x) => x -> y -> T a
 200         --
 201         -- The next six fields express the type of the constructor, in pieces
 202         -- e.g.
 203         --
 204         --      dcUnivTyVars  = [a]
 205         --      dcExTyVars    = [x,y]
 206         --      dcEqSpec      = [a:=:(x,y)]
 207         --      dcTheta       = [Ord x]
 208         --      dcOrigArgTys  = [a,List b]
 209         --      dcTyCon       = T
 210
 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)
 220
 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.]
 228
 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
 237
 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
 243
 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
 250                 --
 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
 253                 --
 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.
 258
 259         dcOrigArgTys :: [Type],         -- Original argument types
 260                                         -- (before unboxing and flattening of strict fields)
 261
 262         -- Result type of constructor is T t1..tn
 263         dcTyCon  :: TyCon,              -- Result tycon, T
 264
 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
 270
 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.
 275
 276         -- Constructor representation
 277         dcRepArgTys :: [Type],          -- Final, representation argument types,
 278                                         -- after unboxing and flattening,
 279                                         -- and *including* existential dictionaries
 280
 281         dcRepStrictness :: [StrictnessMark],    -- One for each *representation* argument
 282
 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
 293         -- use in CoreLint.
 294
 295
 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.
 299         --
 300         -- An entirely separate wrapper function is built in TcTyDecls
 301         dcIds :: DataConIds,
 302
 303         dcInfix :: Bool         -- True <=> declared infix
 304                                 -- Used for Template Haskell and 'deriving' only
 305                                 -- The actual fixity is stored elsewhere
 306   }
 307
 308 data DataConIds
 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.
 313
 314         -- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments
 315
 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
 319
 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
 325         --              f (:) x
 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.)
 331
 332 type ConTag = Int
 333
 334 fIRST_TAG :: ConTag
 335 fIRST_TAG =  1  -- Tags allocated from here for real constructors
 336 \end{code}
 337
 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
 345
 346         b) the constructor may store an unboxed version of a strict field.
 347
 348 Here's an example illustrating both:
 349         data Ord a => T a = MkT Int! a
 350 Here
 351         T :: Ord a => Int -> a -> T a
 352 but the rep type is
 353         Trep :: Int# -> a -> T a
 354 Actually, the unboxed part isn't implemented yet!
 355
 356
 357 %************************************************************************
 358 %*                                                                      *
 359 \subsection{Instances}
 360 %*                                                                      *
 361 %************************************************************************
 362
 363 \begin{code}
 364 instance Eq DataCon where
 365     a == b = getUnique a == getUnique b
 366     a /= b = getUnique a /= getUnique b
 367
 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
 374
 375 instance Uniquable DataCon where
 376     getUnique = dcUnique
 377
 378 instance NamedThing DataCon where
 379     getName = dcName
 380
 381 instance Outputable DataCon where
 382     ppr con = ppr (dataConName con)
 383
 384 instance Show DataCon where
 385     showsPrec p con = showsPrecSDoc p (ppr con)
 386 \end{code}
 387
 388
 389 %************************************************************************
 390 %*                                                                      *
 391 \subsection{Construction}
 392 %*                                                                      *
 393 %************************************************************************
 394
 395 \begin{code}
 396 mkDataCon :: Name
 397           -> Bool       -- Declared infix
 398           -> [StrictnessMark] -> [FieldLabel]
 399           -> [TyVar] -> [TyVar]
 400           -> [(TyVar,Type)] -> ThetaType
 401           -> [Type] -> TyCon
 402           -> ThetaType -> DataConIds
 403           -> DataCon
 404   -- Can get the tag from the TyCon
 405
 406 mkDataCon name declared_infix
 407           arg_stricts   -- Must match orig_arg_tys 1-1
 408           fields
 409           univ_tvs ex_tvs
 410           eq_spec theta
 411           orig_arg_tys tycon
 412           stupid_theta ids
 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)
 416     con
 417   where
 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,
 424                   dcEqSpec = eq_spec,
 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,
 430                   dcIds = ids }
 431
 432         -- Strictness marks for source-args
 433         --      *after unboxing choices*,
 434         -- but  *including existential dictionaries*
 435         --
 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
 442
 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
 446
 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)
 455
 456 eqSpecPreds :: [(TyVar,Type)] -> ThetaType
 457 eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv, ty) | (tv,ty) <- spec ]
 458
 459 mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
 460                          | otherwise         = NotMarkedStrict
 461 \end{code}
 462
 463 \begin{code}
 464 dataConName :: DataCon -> Name
 465 dataConName = dcName
 466
 467 dataConTag :: DataCon -> ConTag
 468 dataConTag  = dcTag
 469
 470 dataConTyCon :: DataCon -> TyCon
 471 dataConTyCon = dcTyCon
 472
 473 dataConRepType :: DataCon -> Type
 474 dataConRepType = dcRepType
 475
 476 dataConIsInfix :: DataCon -> Bool
 477 dataConIsInfix = dcInfix
 478
 479 dataConUnivTyVars :: DataCon -> [TyVar]
 480 dataConUnivTyVars = dcUnivTyVars
 481
 482 dataConExTyVars :: DataCon -> [TyVar]
 483 dataConExTyVars = dcExTyVars
 484
 485 dataConAllTyVars :: DataCon -> [TyVar]
 486 dataConAllTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
 487   = univ_tvs ++ ex_tvs
 488
 489 dataConEqSpec :: DataCon -> [(TyVar,Type)]
 490 dataConEqSpec = dcEqSpec
 491
 492 dataConTheta :: DataCon -> ThetaType
 493 dataConTheta = dcTheta
 494
 495 dataConWorkId :: DataCon -> Id
 496 dataConWorkId dc = case dcIds dc of
 497                         AlgDC _ wrk_id -> wrk_id
 498                         NewDC _ -> pprPanic "dataConWorkId" (ppr dc)
 499
 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
 506
 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
 512                         NewDC wrap            -> wrap
 513
 514 dataConImplicitIds :: DataCon -> [Id]
 515 dataConImplicitIds dc = case dcIds dc of
 516                           AlgDC (Just wrap) work -> [wrap,work]
 517                           AlgDC Nothing     work -> [work]
 518                           NewDC wrap             -> [wrap]
 519
 520 dataConFieldLabels :: DataCon -> [FieldLabel]
 521 dataConFieldLabels = dcFields
 522
 523 dataConFieldType :: DataCon -> FieldLabel -> Type
 524 dataConFieldType con label = expectJust "unexpected label" $
 525     lookup label (dcFields con `zip` dcOrigArgTys con)
 526
 527 dataConStrictMarks :: DataCon -> [StrictnessMark]
 528 dataConStrictMarks = dcStrictMarks
 529
 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)
 534
 535 dataConSourceArity :: DataCon -> Arity
 536         -- Source-level arity of the data constructor
 537 dataConSourceArity dc = length (dcOrigArgTys dc)
 538
 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
 542 -- dictionaries
 543 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
 544
 545 isNullarySrcDataCon, isNullaryRepDataCon :: DataCon -> Bool
 546 isNullarySrcDataCon dc = null (dcOrigArgTys dc)
 547 isNullaryRepDataCon dc = null (dcRepArgTys dc)
 548
 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
 553
 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)
 558
 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)
 564
 565 dataConStupidTheta :: DataCon -> ThetaType
 566 dataConStupidTheta dc = dcStupidTheta dc
 567
 568 dataConResTys :: DataCon -> [Type]
 569 dataConResTys dc = [substTyVar env tv | tv <- dcUnivTyVars dc]
 570   where
 571     env = mkTopTvSubst (dcEqSpec dc)
 572
 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]
 577 -- rather than
 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,
 582                            dcTyCon = tycon })
 583   = mkForAllTys ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs) $
 584     mkFunTys (mkPredTys theta) $
 585     mkFunTys arg_tys $
 586     mkTyConApp tycon (map (substTyVar subst) univ_tvs)
 587   where
 588     subst = mkTopTvSubst eq_spec
 589
 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
 602  where
 603    tyvars = univ_tvs ++ ex_tvs
 604
 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
 612  where
 613    tyvars = univ_tvs ++ ex_tvs
 614 \end{code}
 615
 616 These two functions get the real argument types of the constructor,
 617 without substituting for any type variables.
 618
 619 dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
 620
 621 dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
 622 after any flattening has been done.
 623
 624 \begin{code}
 625 dataConOrigArgTys :: DataCon -> [Type]
 626 dataConOrigArgTys dc = dcOrigArgTys dc
 627
 628 dataConRepArgTys :: DataCon -> [Type]
 629 dataConRepArgTys dc = dcRepArgTys dc
 630 \end{code}
 631
 632
 633 \begin{code}
 634 isTupleCon :: DataCon -> Bool
 635 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
 636
 637 isUnboxedTupleCon :: DataCon -> Bool
 638 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
 639
 640 isVanillaDataCon :: DataCon -> Bool
 641 isVanillaDataCon dc = dcVanilla dc
 642 \end{code}
 643
 644
 645 \begin{code}
 646 classDataCon :: Class -> DataCon
 647 classDataCon clas = case tyConDataCons (classTyCon clas) of
 648                       (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
 649 \end{code}
 650
 651 %************************************************************************
 652 %*                                                                      *
 653 \subsection{Splitting products}
 654 %*                                                                      *
 655 %************************************************************************
 656
 657 \begin{code}
 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
 664
 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
 670         --
 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.
 674
 675 splitProductType_maybe ty
 676   = case splitTyConApp_maybe ty of
 677         Just (tycon,ty_args)
 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)
 681            where
 682               data_con = head (tyConDataCons tycon)
 683         other -> Nothing
 684
 685 splitProductType str ty
 686   = case splitProductType_maybe ty of
 687         Just stuff -> stuff
 688         Nothing    -> pprPanic (str ++ ": not a product") (pprType ty)
 689
 690
 691 deepSplitProductType_maybe ty
 692   = do { (res@(tycon, tycon_args, _, _)) <- splitProductType_maybe ty
 693        ; let {result
 694              | isNewTyCon tycon && not (isRecursiveTyCon tycon)
 695              = deepSplitProductType_maybe (newTyConInstRhs tycon tycon_args)
 696              | otherwise = Just res}
 697        ; result
 698        }
 699
 700 deepSplitProductType str ty
 701   = case deepSplitProductType_maybe ty of
 702       Just stuff -> stuff
 703       Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
 704
 705 computeRep :: [StrictnessMark]          -- Original arg strictness
 706            -> [Type]                    -- and types
 707            -> ([StrictnessMark],        -- Representation arg strictness
 708                [Type])                  -- And type
 709
 710 computeRep stricts tys
 711   = unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
 712   where
 713     unbox NotMarkedStrict ty = [(NotMarkedStrict, ty)]
 714     unbox MarkedStrict    ty = [(MarkedStrict,    ty)]
 715     unbox MarkedUnboxed   ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
 716                                where
 717                                  (tycon, tycon_args, arg_dc, arg_tys)
 718                                      = deepSplitProductType "unbox_strict_arg_ty" ty
 719 \end{code}