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