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