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