compiler/basicTypes/DataCon.lhs

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