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, tyConFamInst_maybe )
  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,
 463                   dcRepStrictness = rep_arg_stricts,
 464                   dcFields = fields, dcTag = tag, dcRepType = ty,
 465                   dcIds = ids }
 466
 467         -- Strictness marks for source-args
 468         --      *after unboxing choices*,
 469         -- but  *including existential dictionaries*
 470         --
 471         -- The 'arg_stricts' passed to mkDataCon are simply those for the
 472         -- source-language arguments.  We add extra ones for the
 473         -- dictionary arguments right here.
 474     dict_tys     = mkPredTys theta
 475     real_arg_tys = dict_tys                      ++ orig_arg_tys
 476     real_stricts = map mk_dict_strict_mark theta ++ arg_stricts
 477
 478         -- Representation arguments and demands
 479         -- To do: eliminate duplication with MkId
 480     (rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
 481
 482     tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
 483     ty  = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $
 484           mkFunTys (mkPredTys (eqSpecPreds eq_spec)) $
 485                 -- NB:  the dict args are already in rep_arg_tys
 486                 --      because they might be flattened..
 487                 --      but the equality predicates are not
 488           mkFunTys rep_arg_tys $
 489           mkTyConApp tycon (mkTyVarTys univ_tvs)
 490
 491 eqSpecPreds :: [(TyVar,Type)] -> ThetaType
 492 eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv, ty) | (tv,ty) <- spec ]
 493
 494 mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
 495                          | otherwise         = NotMarkedStrict
 496 \end{code}
 497
 498 \begin{code}
 499 dataConName :: DataCon -> Name
 500 dataConName = dcName
 501
 502 dataConTag :: DataCon -> ConTag
 503 dataConTag  = dcTag
 504
 505 dataConTyCon :: DataCon -> TyCon
 506 dataConTyCon = dcTyCon
 507
 508 dataConRepType :: DataCon -> Type
 509 dataConRepType = dcRepType
 510
 511 dataConIsInfix :: DataCon -> Bool
 512 dataConIsInfix = dcInfix
 513
 514 dataConUnivTyVars :: DataCon -> [TyVar]
 515 dataConUnivTyVars = dcUnivTyVars
 516
 517 dataConExTyVars :: DataCon -> [TyVar]
 518 dataConExTyVars = dcExTyVars
 519
 520 dataConAllTyVars :: DataCon -> [TyVar]
 521 dataConAllTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
 522   = univ_tvs ++ ex_tvs
 523
 524 dataConEqSpec :: DataCon -> [(TyVar,Type)]
 525 dataConEqSpec = dcEqSpec
 526
 527 dataConTheta :: DataCon -> ThetaType
 528 dataConTheta = dcTheta
 529
 530 dataConWorkId :: DataCon -> Id
 531 dataConWorkId dc = case dcIds dc of
 532                         DCIds _ wrk_id -> wrk_id
 533
 534 dataConWrapId_maybe :: DataCon -> Maybe Id
 535 -- Returns Nothing if there is no wrapper for an algebraic data con
 536 --                 and also for a newtype (whose constructor is inlined compulsorily)
 537 dataConWrapId_maybe dc = case dcIds dc of
 538                                 DCIds mb_wrap _ -> mb_wrap
 539
 540 dataConWrapId :: DataCon -> Id
 541 -- Returns an Id which looks like the Haskell-source constructor
 542 dataConWrapId dc = case dcIds dc of
 543                         DCIds (Just wrap) _   -> wrap
 544                         DCIds Nothing     wrk -> wrk        -- worker=wrapper
 545
 546 dataConImplicitIds :: DataCon -> [Id]
 547 dataConImplicitIds dc = case dcIds dc of
 548                           DCIds (Just wrap) work -> [wrap,work]
 549                           DCIds Nothing     work -> [work]
 550
 551 dataConFieldLabels :: DataCon -> [FieldLabel]
 552 dataConFieldLabels = dcFields
 553
 554 dataConFieldType :: DataCon -> FieldLabel -> Type
 555 dataConFieldType con label = expectJust "unexpected label" $
 556     lookup label (dcFields con `zip` dcOrigArgTys con)
 557
 558 dataConStrictMarks :: DataCon -> [StrictnessMark]
 559 dataConStrictMarks = dcStrictMarks
 560
 561 dataConExStricts :: DataCon -> [StrictnessMark]
 562 -- Strictness of *existential* arguments only
 563 -- Usually empty, so we don't bother to cache this
 564 dataConExStricts dc = map mk_dict_strict_mark (dcTheta dc)
 565
 566 dataConSourceArity :: DataCon -> Arity
 567         -- Source-level arity of the data constructor
 568 dataConSourceArity dc = length (dcOrigArgTys dc)
 569
 570 -- dataConRepArity gives the number of actual fields in the
 571 -- {\em representation} of the data constructor.  This may be more than appear
 572 -- in the source code; the extra ones are the existentially quantified
 573 -- dictionaries
 574 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
 575
 576 isNullarySrcDataCon, isNullaryRepDataCon :: DataCon -> Bool
 577 isNullarySrcDataCon dc = null (dcOrigArgTys dc)
 578 isNullaryRepDataCon dc = null (dcRepArgTys dc)
 579
 580 dataConRepStrictness :: DataCon -> [StrictnessMark]
 581         -- Give the demands on the arguments of a
 582         -- Core constructor application (Con dc args)
 583 dataConRepStrictness dc = dcRepStrictness dc
 584
 585 dataConSig :: DataCon -> ([TyVar], ThetaType, [Type])
 586 dataConSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
 587                     dcTheta  = theta, dcOrigArgTys = arg_tys, dcTyCon = tycon})
 588   = (univ_tvs ++ ex_tvs, eqSpecPreds eq_spec ++ theta, arg_tys)
 589
 590 dataConFullSig :: DataCon
 591                -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, [Type])
 592 dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
 593                         dcTheta  = theta, dcOrigArgTys = arg_tys, dcTyCon = tycon})
 594   = (univ_tvs, ex_tvs, eq_spec, theta, arg_tys)
 595
 596 dataConStupidTheta :: DataCon -> ThetaType
 597 dataConStupidTheta dc = dcStupidTheta dc
 598
 599 dataConResTys :: DataCon -> [Type]
 600 dataConResTys dc = [substTyVar env tv | tv <- dcUnivTyVars dc]
 601   where
 602     env = mkTopTvSubst (dcEqSpec dc)
 603
 604 dataConUserType :: DataCon -> Type
 605 -- The user-declared type of the data constructor
 606 -- in the nice-to-read form
 607 --      T :: forall a. a -> T [a]
 608 -- rather than
 609 --      T :: forall b. forall a. (a=[b]) => a -> T b
 610 -- NB: If the constructor is part of a data instance, the result type
 611 -- mentions the family tycon, not the internal one.
 612 dataConUserType  (MkData { dcUnivTyVars = univ_tvs,
 613                            dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
 614                            dcTheta = theta, dcOrigArgTys = arg_tys,
 615                            dcTyCon = tycon })
 616   = mkForAllTys ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs) $
 617     mkFunTys (mkPredTys theta) $
 618     mkFunTys arg_tys $
 619     case tyConFamInst_maybe tycon of
 620       Nothing             -> mkTyConApp tycon (map (substTyVar subst) univ_tvs)
 621       Just (ftc, insttys) -> mkTyConApp ftc insttys         -- data instance
 622   where
 623     subst = mkTopTvSubst eq_spec
 624
 625 dataConInstArgTys :: DataCon
 626                   -> [Type]     -- Instantiated at these types
 627                                 -- NB: these INCLUDE the existentially quantified arg types
 628                   -> [Type]     -- Needs arguments of these types
 629                                 -- NB: these INCLUDE the existentially quantified dict args
 630                                 --     but EXCLUDE the data-decl context which is discarded
 631                                 -- It's all post-flattening etc; this is a representation type
 632 dataConInstArgTys (MkData {dcRepArgTys = arg_tys,
 633                            dcUnivTyVars = univ_tvs,
 634                            dcExTyVars = ex_tvs}) inst_tys
 635  = ASSERT( length tyvars == length inst_tys )
 636    map (substTyWith tyvars inst_tys) arg_tys
 637  where
 638    tyvars = univ_tvs ++ ex_tvs
 639
 640
 641 -- And the same deal for the original arg tys
 642 dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
 643 dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
 644                                dcUnivTyVars = univ_tvs,
 645                                dcExTyVars = ex_tvs}) inst_tys
 646  = ASSERT2( length tyvars == length inst_tys, ptext SLIT("dataConInstOrigArgTys") <+> ppr dc <+> ppr inst_tys )
 647    map (substTyWith tyvars inst_tys) arg_tys
 648  where
 649    tyvars = univ_tvs ++ ex_tvs
 650 \end{code}
 651
 652 These two functions get the real argument types of the constructor,
 653 without substituting for any type variables.
 654
 655 dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
 656
 657 dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
 658 after any flattening has been done.
 659
 660 \begin{code}
 661 dataConOrigArgTys :: DataCon -> [Type]
 662 dataConOrigArgTys dc = dcOrigArgTys dc
 663
 664 dataConRepArgTys :: DataCon -> [Type]
 665 dataConRepArgTys dc = dcRepArgTys dc
 666 \end{code}
 667
 668
 669 \begin{code}
 670 isTupleCon :: DataCon -> Bool
 671 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
 672
 673 isUnboxedTupleCon :: DataCon -> Bool
 674 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
 675
 676 isVanillaDataCon :: DataCon -> Bool
 677 isVanillaDataCon dc = dcVanilla dc
 678 \end{code}
 679
 680
 681 \begin{code}
 682 classDataCon :: Class -> DataCon
 683 classDataCon clas = case tyConDataCons (classTyCon clas) of
 684                       (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
 685 \end{code}
 686
 687 %************************************************************************
 688 %*                                                                      *
 689 \subsection{Splitting products}
 690 %*                                                                      *
 691 %************************************************************************
 692
 693 \begin{code}
 694 splitProductType_maybe
 695         :: Type                         -- A product type, perhaps
 696         -> Maybe (TyCon,                -- The type constructor
 697                   [Type],               -- Type args of the tycon
 698                   DataCon,              -- The data constructor
 699                   [Type])               -- Its *representation* arg types
 700
 701         -- Returns (Just ...) for any
 702         --      concrete (i.e. constructors visible)
 703         --      single-constructor
 704         --      not existentially quantified
 705         -- type whether a data type or a new type
 706         --
 707         -- Rejecing existentials is conservative.  Maybe some things
 708         -- could be made to work with them, but I'm not going to sweat
 709         -- it through till someone finds it's important.
 710
 711 splitProductType_maybe ty
 712   = case splitTyConApp_maybe ty of
 713         Just (tycon,ty_args)
 714            | isProductTyCon tycon       -- Includes check for non-existential,
 715                                         -- and for constructors visible
 716            -> Just (tycon, ty_args, data_con, dataConInstArgTys data_con ty_args)
 717            where
 718               data_con = head (tyConDataCons tycon)
 719         other -> Nothing
 720
 721 splitProductType str ty
 722   = case splitProductType_maybe ty of
 723         Just stuff -> stuff
 724         Nothing    -> pprPanic (str ++ ": not a product") (pprType ty)
 725
 726
 727 deepSplitProductType_maybe ty
 728   = do { (res@(tycon, tycon_args, _, _)) <- splitProductType_maybe ty
 729        ; let {result
 730              | isNewTyCon tycon && not (isRecursiveTyCon tycon)
 731              = deepSplitProductType_maybe (newTyConInstRhs tycon tycon_args)
 732              | isNewTyCon tycon = Nothing  -- cannot unbox through recursive newtypes
 733              | otherwise = Just res}
 734        ; result
 735        }
 736
 737 deepSplitProductType str ty
 738   = case deepSplitProductType_maybe ty of
 739       Just stuff -> stuff
 740       Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
 741
 742 computeRep :: [StrictnessMark]          -- Original arg strictness
 743            -> [Type]                    -- and types
 744            -> ([StrictnessMark],        -- Representation arg strictness
 745                [Type])                  -- And type
 746
 747 computeRep stricts tys
 748   = unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
 749   where
 750     unbox NotMarkedStrict ty = [(NotMarkedStrict, ty)]
 751     unbox MarkedStrict    ty = [(MarkedStrict,    ty)]
 752     unbox MarkedUnboxed   ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
 753                                where
 754                                  (tycon, tycon_args, arg_dc, arg_tys)
 755                                      = deepSplitProductType "unbox_strict_arg_ty" ty
 756 \end{code}