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