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 PackageConfig
  48 import Module
  49
  50 import Data.Char
  51 import Data.Word
  52 import Data.List ( partition )
  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. (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),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         --      dcEqTheta     = [x~y]
 242         --      dcDictTheta   = [Ord x]
 243         --      dcOrigArgTys  = [a,List b]
 244         --      dcRepTyCon       = 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 = dcEqTheta = dcDictTheta = []
 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                                         -- INVARIANT: length matches arity of the dcRepTyCon
 258
 259         dcExTyVars   :: [TyVar],        -- Existentially-quantified type vars
 260                 -- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
 261                 -- FOR THE PARENT TyCon. With GADTs the data con might not even have
 262                 -- the same number of type variables.
 263                 -- [This is a change (Oct05): previously, vanilla datacons guaranteed to
 264                 --  have the same type variables as their parent TyCon, but that seems ugly.]
 265
 266         -- INVARIANT: the UnivTyVars and ExTyVars all have distinct OccNames
 267         -- Reason: less confusing, and easier to generate IfaceSyn
 268
 269         dcEqSpec :: [(TyVar,Type)],     -- Equalities derived from the result type,
 270                                         -- *as written by the programmer*
 271                 -- This field allows us to move conveniently between the two ways
 272                 -- of representing a GADT constructor's type:
 273                 --      MkT :: forall a b. (a :=: [b]) => b -> T a
 274                 --      MkT :: forall b. b -> T [b]
 275                 -- Each equality is of the form (a :=: ty), where 'a' is one of
 276                 -- the universally quantified type variables
 277
 278                 -- The next two fields give the type context of the data constructor
 279                 --      (aside from the GADT constraints,
 280                 --       which are given by the dcExpSpec)
 281                 -- In GADT form, this is *exactly* what the programmer writes, even if
 282                 -- the context constrains only universally quantified variables
 283                 --      MkT :: forall a b. (a ~ b, Ord b) => a -> T a b
 284         dcEqTheta   :: ThetaType,  -- The *equational* constraints
 285         dcDictTheta :: ThetaType,  -- The *type-class and implicit-param* constraints
 286
 287         dcStupidTheta :: ThetaType,     -- The context of the data type declaration
 288                                         --      data Eq a => T a = ...
 289                                         -- or, rather, a "thinned" version thereof
 290                 -- "Thinned", because the Report says
 291                 -- to eliminate any constraints that don't mention
 292                 -- tyvars free in the arg types for this constructor
 293                 --
 294                 -- INVARIANT: the free tyvars of dcStupidTheta are a subset of dcUnivTyVars
 295                 -- Reason: dcStupidTeta is gotten by thinning the stupid theta from the tycon
 296                 --
 297                 -- "Stupid", because the dictionaries aren't used for anything.
 298                 -- Indeed, [as of March 02] they are no longer in the type of
 299                 -- the wrapper Id, because that makes it harder to use the wrap-id
 300                 -- to rebuild values after record selection or in generics.
 301
 302         dcOrigArgTys :: [Type],         -- Original argument types
 303                                         -- (before unboxing and flattening of strict fields)
 304         dcOrigResTy :: Type,            -- Original result type
 305                 -- NB: for a data instance, the original user result type may
 306                 -- differ from the DataCon's representation TyCon.  Example
 307                 --      data instance T [a] where MkT :: a -> T [a]
 308                 -- The OrigResTy is T [a], but the dcRepTyCon might be :T123
 309
 310         -- Now the strictness annotations and field labels of the constructor
 311         dcStrictMarks :: [StrictnessMark],
 312                 -- Strictness annotations as decided by the compiler.
 313                 -- Does *not* include the existential dictionaries
 314                 -- length = dataConSourceArity dataCon
 315
 316         dcFields  :: [FieldLabel],
 317                 -- Field labels for this constructor, in the
 318                 -- same order as the dcOrigArgTys;
 319                 -- length = 0 (if not a record) or dataConSourceArity.
 320
 321         -- Constructor representation
 322         dcRepArgTys :: [Type],          -- Final, representation argument types,
 323                                         -- after unboxing and flattening,
 324                                         -- and *including* existential dictionaries
 325
 326         dcRepStrictness :: [StrictnessMark],    -- One for each *representation* argument
 327                 -- See also Note [Data-con worker strictness] in MkId.lhs
 328
 329         -- Result type of constructor is T t1..tn
 330         dcRepTyCon  :: TyCon,           -- Result tycon, T
 331
 332         dcRepType   :: Type,    -- Type of the constructor
 333                                 --      forall a x y. (a:=:(x,y), Ord x) => x -> y -> MkT a
 334                                 -- (this is *not* of the constructor wrapper Id:
 335                                 --  see Note [Data con representation] below)
 336         -- Notice that the existential type parameters come *second*.
 337         -- Reason: in a case expression we may find:
 338         --      case (e :: T t) of { MkT b (d:Ord b) (x:t) (xs:[b]) -> ... }
 339         -- It's convenient to apply the rep-type of MkT to 't', to get
 340         --      forall b. Ord b => ...
 341         -- and use that to check the pattern.  Mind you, this is really only
 342         -- use in CoreLint.
 343
 344
 345         -- Finally, the curried worker function that corresponds to the constructor
 346         -- It doesn't have an unfolding; the code generator saturates these Ids
 347         -- and allocates a real constructor when it finds one.
 348         --
 349         -- An entirely separate wrapper function is built in TcTyDecls
 350         dcIds :: DataConIds,
 351
 352         dcInfix :: Bool         -- True <=> declared infix
 353                                 -- Used for Template Haskell and 'deriving' only
 354                                 -- The actual fixity is stored elsewhere
 355   }
 356
 357 data DataConIds
 358   = DCIds (Maybe Id) Id         -- Algebraic data types always have a worker, and
 359                                 -- may or may not have a wrapper, depending on whether
 360                                 -- the wrapper does anything.  Newtypes just have a worker
 361
 362         -- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments
 363
 364         -- The wrapper takes dcOrigArgTys as its arguments
 365         -- The worker takes dcRepArgTys as its arguments
 366         -- If the worker is absent, dcRepArgTys is the same as dcOrigArgTys
 367
 368         -- The 'Nothing' case of DCIds is important
 369         -- Not only is this efficient,
 370         -- but it also ensures that the wrapper is replaced
 371         -- by the worker (becuase it *is* the worker)
 372         -- even when there are no args. E.g. in
 373         --              f (:) x
 374         -- the (:) *is* the worker.
 375         -- This is really important in rule matching,
 376         -- (We could match on the wrappers,
 377         -- but that makes it less likely that rules will match
 378         -- when we bring bits of unfoldings together.)
 379
 380 type ConTag = Int
 381
 382 fIRST_TAG :: ConTag
 383 fIRST_TAG =  1  -- Tags allocated from here for real constructors
 384 \end{code}
 385
 386 Note [Data con representation]
 387 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 388 The dcRepType field contains the type of the representation of a contructor
 389 This may differ from the type of the contructor *Id* (built
 390 by MkId.mkDataConId) for two reasons:
 391         a) the constructor Id may be overloaded, but the dictionary isn't stored
 392            e.g.    data Eq a => T a = MkT a a
 393
 394         b) the constructor may store an unboxed version of a strict field.
 395
 396 Here's an example illustrating both:
 397         data Ord a => T a = MkT Int! a
 398 Here
 399         T :: Ord a => Int -> a -> T a
 400 but the rep type is
 401         Trep :: Int# -> a -> T a
 402 Actually, the unboxed part isn't implemented yet!
 403
 404
 405 %************************************************************************
 406 %*                                                                      *
 407 \subsection{Instances}
 408 %*                                                                      *
 409 %************************************************************************
 410
 411 \begin{code}
 412 instance Eq DataCon where
 413     a == b = getUnique a == getUnique b
 414     a /= b = getUnique a /= getUnique b
 415
 416 instance Ord DataCon where
 417     a <= b = getUnique a <= getUnique b
 418     a <  b = getUnique a <  getUnique b
 419     a >= b = getUnique a >= getUnique b
 420     a >  b = getUnique a > getUnique b
 421     compare a b = getUnique a `compare` getUnique b
 422
 423 instance Uniquable DataCon where
 424     getUnique = dcUnique
 425
 426 instance NamedThing DataCon where
 427     getName = dcName
 428
 429 instance Outputable DataCon where
 430     ppr con = ppr (dataConName con)
 431
 432 instance Show DataCon where
 433     showsPrec p con = showsPrecSDoc p (ppr con)
 434 \end{code}
 435
 436
 437 %************************************************************************
 438 %*                                                                      *
 439 \subsection{Construction}
 440 %*                                                                      *
 441 %************************************************************************
 442
 443 \begin{code}
 444 mkDataCon :: Name
 445           -> Bool       -- Declared infix
 446           -> [StrictnessMark] -> [FieldLabel]
 447           -> [TyVar] -> [TyVar]
 448           -> [(TyVar,Type)] -> ThetaType
 449           -> [Type] -> TyCon
 450           -> ThetaType -> DataConIds
 451           -> DataCon
 452   -- Can get the tag from the TyCon
 453
 454 mkDataCon name declared_infix
 455           arg_stricts   -- Must match orig_arg_tys 1-1
 456           fields
 457           univ_tvs ex_tvs
 458           eq_spec theta
 459           orig_arg_tys tycon
 460           stupid_theta ids
 461 -- Warning: mkDataCon is not a good place to check invariants.
 462 -- If the programmer writes the wrong result type in the decl, thus:
 463 --      data T a where { MkT :: S }
 464 -- then it's possible that the univ_tvs may hit an assertion failure
 465 -- if you pull on univ_tvs.  This case is checked by checkValidDataCon,
 466 -- so the error is detected properly... it's just that asaertions here
 467 -- are a little dodgy.
 468
 469   = -- ASSERT( not (any isEqPred theta) )
 470         -- We don't currently allow any equality predicates on
 471         -- a data constructor (apart from the GADT ones in eq_spec)
 472     con
 473   where
 474     is_vanilla = null ex_tvs && null eq_spec && null theta
 475     con = MkData {dcName = name, dcUnique = nameUnique name,
 476                   dcVanilla = is_vanilla, dcInfix = declared_infix,
 477                   dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
 478                   dcEqSpec = eq_spec,
 479                   dcStupidTheta = stupid_theta,
 480                   dcEqTheta = eq_theta, dcDictTheta = dict_theta,
 481                   dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty,
 482                   dcRepTyCon = tycon,
 483                   dcRepArgTys = rep_arg_tys,
 484                   dcStrictMarks = arg_stricts,
 485                   dcRepStrictness = rep_arg_stricts,
 486                   dcFields = fields, dcTag = tag, dcRepType = ty,
 487                   dcIds = ids }
 488
 489         -- Strictness marks for source-args
 490         --      *after unboxing choices*,
 491         -- but  *including existential dictionaries*
 492         --
 493         -- The 'arg_stricts' passed to mkDataCon are simply those for the
 494         -- source-language arguments.  We add extra ones for the
 495         -- dictionary arguments right here.
 496     (eq_theta,dict_theta)  = partition isEqPred theta
 497     dict_tys               = mkPredTys dict_theta
 498     real_arg_tys           = dict_tys ++ orig_arg_tys
 499     real_stricts           = map mk_dict_strict_mark dict_theta ++ arg_stricts
 500
 501         -- Example
 502         --   data instance T (b,c) where
 503         --      TI :: forall e. e -> T (e,e)
 504         --
 505         -- The representation tycon looks like this:
 506         --   data :R7T b c where
 507         --      TI :: forall b1 c1. (b1 ~ c1) => b1 -> :R7T b1 c1
 508         -- In this case orig_res_ty = T (e,e)
 509     orig_res_ty = mkFamilyTyConApp tycon (substTyVars (mkTopTvSubst eq_spec) univ_tvs)
 510
 511         -- Representation arguments and demands
 512         -- To do: eliminate duplication with MkId
 513     (rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
 514
 515     tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
 516     ty  = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $
 517           mkFunTys (mkPredTys (eqSpecPreds eq_spec)) $
 518           mkFunTys (mkPredTys eq_theta) $
 519                 -- NB:  the dict args are already in rep_arg_tys
 520                 --      because they might be flattened..
 521                 --      but the equality predicates are not
 522           mkFunTys rep_arg_tys $
 523           mkTyConApp tycon (mkTyVarTys univ_tvs)
 524
 525 eqSpecPreds :: [(TyVar,Type)] -> ThetaType
 526 eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv, ty) | (tv,ty) <- spec ]
 527
 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 (MkData {dcRepArgTys = arg_tys}) = length arg_tys
 612
 613 isNullarySrcDataCon, isNullaryRepDataCon :: DataCon -> Bool
 614 isNullarySrcDataCon dc = null (dcOrigArgTys dc)
 615 isNullaryRepDataCon dc = null (dcRepArgTys dc)
 616
 617 dataConRepStrictness :: DataCon -> [StrictnessMark]
 618         -- Give the demands on the arguments of a
 619         -- Core constructor application (Con dc args)
 620 dataConRepStrictness dc = dcRepStrictness dc
 621
 622 dataConSig :: DataCon -> ([TyVar], ThetaType, [Type], Type)
 623 dataConSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
 624                     dcEqTheta  = eq_theta, dcDictTheta = dict_theta, dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
 625   = (univ_tvs ++ ex_tvs, eqSpecPreds eq_spec ++ eq_theta ++ dict_theta, arg_tys, res_ty)
 626
 627 dataConFullSig :: DataCon
 628                -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, ThetaType, [Type], Type)
 629 dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
 630                         dcEqTheta = eq_theta, dcDictTheta = dict_theta, dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
 631   = (univ_tvs, ex_tvs, eq_spec, eq_theta, dict_theta, arg_tys, res_ty)
 632
 633 dataConOrigResTy :: DataCon -> Type
 634 dataConOrigResTy dc = dcOrigResTy dc
 635
 636 dataConStupidTheta :: DataCon -> ThetaType
 637 dataConStupidTheta dc = dcStupidTheta dc
 638
 639 dataConUserType :: DataCon -> Type
 640 -- The user-declared type of the data constructor
 641 -- in the nice-to-read form
 642 --      T :: forall a b. a -> b -> T [a]
 643 -- rather than
 644 --      T :: forall a c. forall b. (c=[a]) => a -> b -> T c
 645 -- NB: If the constructor is part of a data instance, the result type
 646 -- mentions the family tycon, not the internal one.
 647 dataConUserType  (MkData { dcUnivTyVars = univ_tvs,
 648                            dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
 649                            dcEqTheta = eq_theta, dcDictTheta = dict_theta, dcOrigArgTys = arg_tys,
 650                            dcOrigResTy = res_ty })
 651   = mkForAllTys ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs) $
 652     mkFunTys (mkPredTys eq_theta) $
 653     mkFunTys (mkPredTys dict_theta) $
 654     mkFunTys arg_tys $
 655     res_ty
 656
 657 dataConInstArgTys :: DataCon    -- A datacon with no existentials or equality constraints
 658                                 -- However, it can have a dcTheta (notably it can be a
 659                                 -- class dictionary, with superclasses)
 660                   -> [Type]     -- Instantiated at these types
 661                   -> [Type]     -- Needs arguments of these types
 662                                 -- NB: these INCLUDE any dict args
 663                                 --     but EXCLUDE the data-decl context which is discarded
 664                                 -- It's all post-flattening etc; this is a representation type
 665 dataConInstArgTys dc@(MkData {dcRepArgTys = rep_arg_tys,
 666                               dcUnivTyVars = univ_tvs, dcEqSpec = eq_spec,
 667                               dcExTyVars = ex_tvs}) inst_tys
 668  = ASSERT2 ( length univ_tvs == length inst_tys
 669            , ptext SLIT("dataConInstArgTys") <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
 670    ASSERT2 ( null ex_tvs && null eq_spec, ppr dc )
 671    map (substTyWith univ_tvs inst_tys) rep_arg_tys
 672
 673 dataConInstOrigArgTys
 674         :: DataCon      -- Works for any DataCon
 675         -> [Type]       -- Includes existential tyvar args, but NOT
 676                         -- equality constraints or dicts
 677         -> [Type]       -- Returns just the instsantiated *value* arguments
 678 -- For vanilla datacons, it's all quite straightforward
 679 -- But for the call in MatchCon, we really do want just the value args
 680 dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
 681                                   dcUnivTyVars = univ_tvs,
 682                                   dcExTyVars = ex_tvs}) inst_tys
 683   = ASSERT2( length tyvars == length inst_tys
 684           , ptext SLIT("dataConInstOrigArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
 685     map (substTyWith tyvars inst_tys) arg_tys
 686   where
 687     tyvars = univ_tvs ++ ex_tvs
 688
 689 dataConInstOrigDictsAndArgTys
 690         :: DataCon      -- Works for any DataCon
 691         -> [Type]       -- Includes existential tyvar args, but NOT
 692                         -- equality constraints or dicts
 693         -> [Type]       -- Returns just the instsantiated dicts and *value* arguments
 694 dataConInstOrigDictsAndArgTys dc@(MkData {dcOrigArgTys = arg_tys,
 695                                   dcDictTheta = dicts,
 696                                   dcUnivTyVars = univ_tvs,
 697                                   dcExTyVars = ex_tvs}) inst_tys
 698   = ASSERT2( length tyvars == length inst_tys
 699           , ptext SLIT("dataConInstOrigDictsAndArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
 700     map (substTyWith tyvars inst_tys) (mkPredTys dicts ++ arg_tys)
 701   where
 702     tyvars = univ_tvs ++ ex_tvs
 703 \end{code}
 704
 705 These two functions get the real argument types of the constructor,
 706 without substituting for any type variables.
 707
 708 dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
 709
 710 dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
 711 after any flattening has been done.
 712
 713 \begin{code}
 714 dataConOrigArgTys :: DataCon -> [Type]
 715 dataConOrigArgTys dc = dcOrigArgTys dc
 716
 717 dataConRepArgTys :: DataCon -> [Type]
 718 dataConRepArgTys dc = dcRepArgTys dc
 719 \end{code}
 720
 721 The string <package>:<module>.<name> identifying a constructor, which is attached
 722 to its info table and used by the GHCi debugger and the heap profiler.  We want
 723 this string to be UTF-8, so we get the bytes directly from the FastStrings.
 724
 725 \begin{code}
 726 dataConIdentity :: DataCon -> [Word8]
 727 dataConIdentity dc = bytesFS (packageIdFS (modulePackageId mod)) ++
 728                   fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++
 729                   fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
 730   where name = dataConName dc
 731         mod  = nameModule name
 732 \end{code}
 733
 734
 735 \begin{code}
 736 isTupleCon :: DataCon -> Bool
 737 isTupleCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc
 738
 739 isUnboxedTupleCon :: DataCon -> Bool
 740 isUnboxedTupleCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc
 741
 742 isVanillaDataCon :: DataCon -> Bool
 743 isVanillaDataCon dc = dcVanilla dc
 744 \end{code}
 745
 746
 747 \begin{code}
 748 classDataCon :: Class -> DataCon
 749 classDataCon clas = case tyConDataCons (classTyCon clas) of
 750                       (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
 751                       [] -> panic "classDataCon"
 752 \end{code}
 753
 754 %************************************************************************
 755 %*                                                                      *
 756 \subsection{Splitting products}
 757 %*                                                                      *
 758 %************************************************************************
 759
 760 \begin{code}
 761 splitProductType_maybe
 762         :: Type                         -- A product type, perhaps
 763         -> Maybe (TyCon,                -- The type constructor
 764                   [Type],               -- Type args of the tycon
 765                   DataCon,              -- The data constructor
 766                   [Type])               -- Its *representation* arg types
 767
 768         -- Returns (Just ...) for any
 769         --      concrete (i.e. constructors visible)
 770         --      single-constructor
 771         --      not existentially quantified
 772         -- type whether a data type or a new type
 773         --
 774         -- Rejecing existentials is conservative.  Maybe some things
 775         -- could be made to work with them, but I'm not going to sweat
 776         -- it through till someone finds it's important.
 777
 778 splitProductType_maybe ty
 779   = case splitTyConApp_maybe ty of
 780         Just (tycon,ty_args)
 781            | isProductTyCon tycon       -- Includes check for non-existential,
 782                                         -- and for constructors visible
 783            -> Just (tycon, ty_args, data_con, dataConInstArgTys data_con ty_args)
 784            where
 785               data_con = ASSERT( not (null (tyConDataCons tycon)) )
 786                          head (tyConDataCons tycon)
 787         other -> Nothing
 788
 789 splitProductType str ty
 790   = case splitProductType_maybe ty of
 791         Just stuff -> stuff
 792         Nothing    -> pprPanic (str ++ ": not a product") (pprType ty)
 793
 794
 795 deepSplitProductType_maybe ty
 796   = do { (res@(tycon, tycon_args, _, _)) <- splitProductType_maybe ty
 797        ; let {result
 798              | Just (ty', _co) <- instNewTyCon_maybe tycon tycon_args
 799              , not (isRecursiveTyCon tycon)
 800              = deepSplitProductType_maybe ty'   -- Ignore the coercion?
 801              | isNewTyCon tycon = Nothing  -- cannot unbox through recursive
 802                                            -- newtypes nor through families
 803              | otherwise = Just res}
 804        ; result
 805        }
 806
 807 deepSplitProductType str ty
 808   = case deepSplitProductType_maybe ty of
 809       Just stuff -> stuff
 810       Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
 811
 812 computeRep :: [StrictnessMark]          -- Original arg strictness
 813            -> [Type]                    -- and types
 814            -> ([StrictnessMark],        -- Representation arg strictness
 815                [Type])                  -- And type
 816
 817 computeRep stricts tys
 818   = unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
 819   where
 820     unbox NotMarkedStrict ty = [(NotMarkedStrict, ty)]
 821     unbox MarkedStrict    ty = [(MarkedStrict,    ty)]
 822     unbox MarkedUnboxed   ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
 823                                where
 824                                  (_tycon, _tycon_args, arg_dc, arg_tys)
 825                                      = deepSplitProductType "unbox_strict_arg_ty" ty
 826 \end{code}