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