compiler/basicTypes/DataCon.lhs

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