compiler/basicTypes/DataCon.lhs

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