ghc/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, dataConName, dataConTag, dataConTyCon,
  12         dataConArgTys, dataConOrigArgTys, dataConInstOrigArgTys,
  13         dataConRepArgTys, dataConTheta,
  14         dataConFieldLabels, dataConStrictMarks, dataConExStricts,
  15         dataConSourceArity, dataConRepArity,
  16         dataConNumInstArgs,
  17         dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds,
  18         dataConRepStrictness,
  19         isNullaryDataCon, isTupleCon, isUnboxedTupleCon,
  20         isExistentialDataCon, classDataCon, dataConExistentialTyVars,
  21
  22         splitProductType_maybe, splitProductType,
  23     ) where
  24
  25 #include "HsVersions.h"
  26
  27 import {-# SOURCE #-} Subst( substTyWith )
  28 import {-# SOURCE #-} PprType( pprType )
  29
  30 import Type             ( Type, ThetaType,
  31                           mkForAllTys, mkFunTys, mkTyConApp,
  32                           mkTyVarTys, splitTyConApp_maybe,
  33                           mkPredTys, isStrictPred
  34                         )
  35 import TyCon            ( TyCon, tyConDataCons, tyConDataCons, isProductTyCon,
  36                           isTupleTyCon, isUnboxedTupleTyCon )
  37 import Class            ( Class, classTyCon )
  38 import Name             ( Name, NamedThing(..), nameUnique )
  39 import Var              ( TyVar, Id )
  40 import FieldLabel       ( FieldLabel )
  41 import BasicTypes       ( Arity, StrictnessMark(..) )
  42 import Outputable
  43 import Unique           ( Unique, Uniquable(..) )
  44 import ListSetOps       ( assoc )
  45 import Util             ( zipEqual, zipWithEqual, notNull )
  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         Its type may be different to the Haskell source constructor
 101         because:
 102                 - useless dict args are dropped
 103                 - strict args may be flattened
 104         The worker is very like a primop, in that it has no binding.
 105
 106         Newtypes currently do get a worker-Id, but it is never used.
 107
 108
 109   The "wrapper Id", $wC, whose type is exactly what it looks like
 110         in the source program. It is an ordinary function,
 111         and it gets a top-level binding like any other function.
 112
 113         The wrapper Id isn't generated for a data type if the worker
 114         and wrapper are identical.  It's always generated for a newtype.
 115
 116
 117
 118 A note about the stupid context
 119 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 120 Data types can have a context:
 121
 122         data (Eq a, Ord b) => T a b = T1 a b | T2 a
 123
 124 and that makes the constructors have a context too
 125 (notice that T2's context is "thinned"):
 126
 127         T1 :: (Eq a, Ord b) => a -> b -> T a b
 128         T2 :: (Eq a) => a -> T a b
 129
 130 Furthermore, this context pops up when pattern matching
 131 (though GHC hasn't implemented this, but it is in H98, and
 132 I've fixed GHC so that it now does):
 133
 134         f (T2 x) = x
 135 gets inferred type
 136         f :: Eq a => T a b -> a
 137
 138 I say the context is "stupid" because the dictionaries passed
 139 are immediately discarded -- they do nothing and have no benefit.
 140 It's a flaw in the language.
 141
 142 Up to now [March 2002] I have put this stupid context into the type of
 143 the "wrapper" constructors functions, T1 and T2, but that turned out
 144 to be jolly inconvenient for generics, and record update, and other
 145 functions that build values of type T (because they don't have
 146 suitable dictionaries available).
 147
 148 So now I've taken the stupid context out.  I simply deal with it
 149 separately in the type checker on occurrences of a constructor, either
 150 in an expression or in a pattern.
 151
 152 [May 2003: actually I think this decision could evasily be reversed now,
 153 and probably should be.  Generics could be disabled for types with
 154 a stupid context; record updates now (H98) needs the context too; etc.
 155 It's an unforced change, so I'm leaving it for now --- but it does seem
 156 odd that the wrapper doesn't include the stupid context.]
 157
 158
 159
 160 %************************************************************************
 161 %*                                                                      *
 162 \subsection{Data constructors}
 163 %*                                                                      *
 164 %************************************************************************
 165
 166 \begin{code}
 167 data DataCon
 168   = MkData {                    -- Used for data constructors only;
 169                                 -- there *is* no constructor for a newtype
 170
 171         dcName    :: Name,      -- This is the name of the *source data con*
 172                                 -- (see "Note [Data Constructor Naming]" above)
 173
 174         dcUnique :: Unique,             -- Cached from Name
 175         dcTag    :: ConTag,
 176
 177         -- Running example:
 178         --
 179         --      data Eq a => T a = forall b. Ord b => MkT a [b]
 180
 181         dcRepType   :: Type,    -- Type of the constructor
 182                                 --      forall a b . Ord b => a -> [b] -> MkT a
 183                                 -- (this is *not* of the constructor wrapper Id:
 184                                 --  see notes after this data type declaration)
 185                                 --
 186         -- Notice that the existential type parameters come *second*.
 187         -- Reason: in a case expression we may find:
 188         --      case (e :: T t) of { MkT b (d:Ord b) (x:t) (xs:[b]) -> ... }
 189         -- It's convenient to apply the rep-type of MkT to 't', to get
 190         --      forall b. Ord b => ...
 191         -- and use that to check the pattern.  Mind you, this is really only
 192         -- use in CoreLint.
 193
 194
 195         -- The next six fields express the type of the constructor, in pieces
 196         -- e.g.
 197         --
 198         --      dcTyVars   = [a]
 199         --      dcTheta    = [Eq a]
 200         --      dcExTyVars = [b]
 201         --      dcExTheta  = [Ord b]
 202         --      dcOrigArgTys   = [a,List b]
 203         --      dcTyCon    = T
 204
 205         dcTyVars :: [TyVar],            -- Type vars for the data type decl
 206                                         -- These are ALWAYS THE SAME AS THE TYVARS
 207                                         -- FOR THE PARENT TyCon.  We occasionally rely on
 208                                         -- this just to avoid redundant instantiation
 209
 210         dcStupidTheta  ::  ThetaType,   -- This is a "thinned" version of the context of
 211                                         -- the data decl.
 212                 -- "Thinned", because the Report says
 213                 -- to eliminate any constraints that don't mention
 214                 -- tyvars free in the arg types for this constructor
 215                 --
 216                 -- "Stupid", because the dictionaries aren't used for anything.
 217                 --
 218                 -- Indeed, [as of March 02] they are no
 219                 -- longer in the type of the wrapper Id, because
 220                 -- that makes it harder to use the wrap-id to rebuild
 221                 -- values after record selection or in generics.
 222
 223         dcExTyVars :: [TyVar],          -- Ditto for the context of the constructor,
 224         dcExTheta  :: ThetaType,        -- the existentially quantified stuff
 225
 226         dcOrigArgTys :: [Type],         -- Original argument types
 227                                         -- (before unboxing and flattening of
 228                                         --  strict fields)
 229
 230         -- Now the strictness annotations and field labels of the constructor
 231         dcStrictMarks :: [StrictnessMark],
 232                 -- Strictness annotations as decided by the compiler.
 233                 -- Does *not* include the existential dictionaries
 234                 -- length = dataConSourceArity dataCon
 235
 236         dcFields  :: [FieldLabel],
 237                 -- Field labels for this constructor, in the
 238                 -- same order as the argument types;
 239                 -- length = 0 (if not a record) or dataConSourceArity.
 240
 241         -- Constructor representation
 242         dcRepArgTys :: [Type],          -- Final, representation argument types,
 243                                         -- after unboxing and flattening,
 244                                         -- and *including* existential dictionaries
 245
 246         dcRepStrictness :: [StrictnessMark],    -- One for each representation argument
 247
 248         dcTyCon  :: TyCon,              -- Result tycon
 249
 250         -- Finally, the curried worker function that corresponds to the constructor
 251         -- It doesn't have an unfolding; the code generator saturates these Ids
 252         -- and allocates a real constructor when it finds one.
 253         --
 254         -- An entirely separate wrapper function is built in TcTyDecls
 255
 256         dcIds :: DataConIds
 257   }
 258
 259 data DataConIds
 260   = NewDC Id                    -- Newtypes have only a wrapper, but no worker
 261   | AlgDC (Maybe Id) Id         -- Algebraic data types always have a worker, and
 262                                 -- may or may not have a wrapper, depending on whether
 263                                 -- the wrapper does anything.
 264
 265         -- *Neither* the worker *nor* the wrapper take the dcStupidTheta dicts as arguments
 266
 267         -- The wrapper takes dcOrigArgTys as its arguments
 268         -- The worker takes dcRepArgTys as its arguments
 269         -- If the worker is absent, dcRepArgTys is the same as dcOrigArgTys
 270
 271         -- The 'Nothing' case of AlgDC is important
 272         -- Not only is this efficient,
 273         -- but it also ensures that the wrapper is replaced
 274         -- by the worker (becuase it *is* the wroker)
 275         -- even when there are no args. E.g. in
 276         --              f (:) x
 277         -- the (:) *is* the worker.
 278         -- This is really important in rule matching,
 279         -- (We could match on the wrappers,
 280         -- but that makes it less likely that rules will match
 281         -- when we bring bits of unfoldings together.)
 282
 283 type ConTag = Int
 284
 285 fIRST_TAG :: ConTag
 286 fIRST_TAG =  1  -- Tags allocated from here for real constructors
 287 \end{code}
 288
 289 The dcRepType field contains the type of the representation of a contructor
 290 This may differ from the type of the contructor *Id* (built
 291 by MkId.mkDataConId) for two reasons:
 292         a) the constructor Id may be overloaded, but the dictionary isn't stored
 293            e.g.    data Eq a => T a = MkT a a
 294
 295         b) the constructor may store an unboxed version of a strict field.
 296
 297 Here's an example illustrating both:
 298         data Ord a => T a = MkT Int! a
 299 Here
 300         T :: Ord a => Int -> a -> T a
 301 but the rep type is
 302         Trep :: Int# -> a -> T a
 303 Actually, the unboxed part isn't implemented yet!
 304
 305
 306 %************************************************************************
 307 %*                                                                      *
 308 \subsection{Instances}
 309 %*                                                                      *
 310 %************************************************************************
 311
 312 \begin{code}
 313 instance Eq DataCon where
 314     a == b = getUnique a == getUnique b
 315     a /= b = getUnique a /= getUnique b
 316
 317 instance Ord DataCon where
 318     a <= b = getUnique a <= getUnique b
 319     a <  b = getUnique a <  getUnique b
 320     a >= b = getUnique a >= getUnique b
 321     a >  b = getUnique a > getUnique b
 322     compare a b = getUnique a `compare` getUnique b
 323
 324 instance Uniquable DataCon where
 325     getUnique = dcUnique
 326
 327 instance NamedThing DataCon where
 328     getName = dcName
 329
 330 instance Outputable DataCon where
 331     ppr con = ppr (dataConName con)
 332
 333 instance Show DataCon where
 334     showsPrec p con = showsPrecSDoc p (ppr con)
 335 \end{code}
 336
 337
 338 %************************************************************************
 339 %*                                                                      *
 340 \subsection{Construction}
 341 %*                                                                      *
 342 %************************************************************************
 343
 344 \begin{code}
 345 mkDataCon :: Name
 346           -> [StrictnessMark] -> [FieldLabel]
 347           -> [TyVar] -> ThetaType
 348           -> [TyVar] -> ThetaType
 349           -> [Type] -> TyCon
 350           -> DataConIds
 351           -> DataCon
 352   -- Can get the tag from the TyCon
 353
 354 mkDataCon name
 355           arg_stricts   -- Must match orig_arg_tys 1-1
 356           fields
 357           tyvars theta ex_tyvars ex_theta orig_arg_tys tycon
 358           ids
 359   = con
 360   where
 361     con = MkData {dcName = name,
 362                   dcUnique = nameUnique name,
 363                   dcTyVars = tyvars, dcStupidTheta = theta,
 364                   dcOrigArgTys = orig_arg_tys,
 365                   dcRepArgTys = rep_arg_tys,
 366                   dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
 367                   dcStrictMarks = arg_stricts, dcRepStrictness = rep_arg_stricts,
 368                   dcFields = fields, dcTag = tag, dcTyCon = tycon, dcRepType = ty,
 369                   dcIds = ids}
 370
 371         -- Strictness marks for source-args
 372         --      *after unboxing choices*,
 373         -- but  *including existential dictionaries*
 374         --
 375         -- The 'arg_stricts' passed to mkDataCon are simply those for the
 376         -- source-language arguments.  We add extra ones for the
 377         -- dictionary arguments right here.
 378     ex_dict_tys  = mkPredTys ex_theta
 379     real_arg_tys = ex_dict_tys                      ++ orig_arg_tys
 380     real_stricts = map mk_dict_strict_mark ex_theta ++ arg_stricts
 381
 382         -- Representation arguments and demands
 383     (rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
 384
 385     tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
 386     ty  = mkForAllTys (tyvars ++ ex_tyvars)
 387                       (mkFunTys rep_arg_tys result_ty)
 388                 -- NB: the existential dict args are already in rep_arg_tys
 389
 390     result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
 391
 392 mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
 393                          | otherwise         = NotMarkedStrict
 394 \end{code}
 395
 396 \begin{code}
 397 dataConName :: DataCon -> Name
 398 dataConName = dcName
 399
 400 dataConTag :: DataCon -> ConTag
 401 dataConTag  = dcTag
 402
 403 dataConTyCon :: DataCon -> TyCon
 404 dataConTyCon = dcTyCon
 405
 406 dataConRepType :: DataCon -> Type
 407 dataConRepType = dcRepType
 408
 409 dataConWorkId :: DataCon -> Id
 410 dataConWorkId dc = case dcIds dc of
 411                         AlgDC _ wrk_id -> wrk_id
 412                         NewDC _ -> pprPanic "dataConWorkId" (ppr dc)
 413
 414 dataConWrapId_maybe :: DataCon -> Maybe Id
 415 dataConWrapId_maybe dc = case dcIds dc of
 416                                 AlgDC mb_wrap _ -> mb_wrap
 417                                 NewDC wrap      -> Just wrap
 418
 419 dataConWrapId :: DataCon -> Id
 420 -- Returns an Id which looks like the Haskell-source constructor
 421 dataConWrapId dc = case dcIds dc of
 422                         AlgDC (Just wrap) _   -> wrap
 423                         AlgDC Nothing     wrk -> wrk        -- worker=wrapper
 424                         NewDC wrap            -> wrap
 425
 426 dataConImplicitIds :: DataCon -> [Id]
 427 dataConImplicitIds dc = case dcIds dc of
 428                           AlgDC (Just wrap) work -> [wrap,work]
 429                           AlgDC Nothing     work -> [work]
 430                           NewDC wrap             -> [wrap]
 431
 432 dataConFieldLabels :: DataCon -> [FieldLabel]
 433 dataConFieldLabels = dcFields
 434
 435 dataConStrictMarks :: DataCon -> [StrictnessMark]
 436 dataConStrictMarks = dcStrictMarks
 437
 438 dataConExStricts :: DataCon -> [StrictnessMark]
 439 -- Strictness of *existential* arguments only
 440 -- Usually empty, so we don't bother to cache this
 441 dataConExStricts dc = map mk_dict_strict_mark (dcExTheta dc)
 442
 443 -- Number of type-instantiation arguments
 444 -- All the remaining arguments of the DataCon are (notionally)
 445 -- stored in the DataCon, and are matched in a case expression
 446 dataConNumInstArgs (MkData {dcTyVars = tyvars}) = length tyvars
 447
 448 dataConSourceArity :: DataCon -> Arity
 449         -- Source-level arity of the data constructor
 450 dataConSourceArity dc = length (dcOrigArgTys dc)
 451
 452 -- dataConRepArity gives the number of actual fields in the
 453 -- {\em representation} of the data constructor.  This may be more than appear
 454 -- in the source code; the extra ones are the existentially quantified
 455 -- dictionaries
 456 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
 457
 458 isNullaryDataCon con  = dataConRepArity con == 0
 459
 460 dataConRepStrictness :: DataCon -> [StrictnessMark]
 461         -- Give the demands on the arguments of a
 462         -- Core constructor application (Con dc args)
 463 dataConRepStrictness dc = dcRepStrictness dc
 464
 465 dataConSig :: DataCon -> ([TyVar], ThetaType,
 466                           [TyVar], ThetaType,
 467                           [Type], TyCon)
 468
 469 dataConSig (MkData {dcTyVars = tyvars, dcStupidTheta = theta,
 470                      dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
 471                      dcOrigArgTys = arg_tys, dcTyCon = tycon})
 472   = (tyvars, theta, ex_tyvars, ex_theta, arg_tys, tycon)
 473
 474 dataConArgTys :: DataCon
 475               -> [Type]         -- Instantiated at these types
 476                                 -- NB: these INCLUDE the existentially quantified arg types
 477               -> [Type]         -- Needs arguments of these types
 478                                 -- NB: these INCLUDE the existentially quantified dict args
 479                                 --     but EXCLUDE the data-decl context which is discarded
 480                                 -- It's all post-flattening etc; this is a representation type
 481
 482 dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
 483                        dcExTyVars = ex_tyvars}) inst_tys
 484  = map (substTyWith (tyvars ++ ex_tyvars) inst_tys) arg_tys
 485
 486 dataConTheta :: DataCon -> ThetaType
 487 dataConTheta dc = dcStupidTheta dc
 488
 489 dataConExistentialTyVars :: DataCon -> [TyVar]
 490 dataConExistentialTyVars dc = dcExTyVars dc
 491
 492 -- And the same deal for the original arg tys:
 493
 494 dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
 495 dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars,
 496                        dcExTyVars = ex_tyvars}) inst_tys
 497  = map (substTyWith (tyvars ++ ex_tyvars) inst_tys) arg_tys
 498 \end{code}
 499
 500 These two functions get the real argument types of the constructor,
 501 without substituting for any type variables.
 502
 503 dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
 504
 505 dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
 506 after any flattening has been done.
 507
 508 \begin{code}
 509 dataConOrigArgTys :: DataCon -> [Type]
 510 dataConOrigArgTys dc = dcOrigArgTys dc
 511
 512 dataConRepArgTys :: DataCon -> [Type]
 513 dataConRepArgTys dc = dcRepArgTys dc
 514 \end{code}
 515
 516
 517 \begin{code}
 518 isTupleCon :: DataCon -> Bool
 519 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
 520
 521 isUnboxedTupleCon :: DataCon -> Bool
 522 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
 523
 524 isExistentialDataCon :: DataCon -> Bool
 525 isExistentialDataCon (MkData {dcExTyVars = tvs}) = notNull tvs
 526 \end{code}
 527
 528
 529 \begin{code}
 530 classDataCon :: Class -> DataCon
 531 classDataCon clas = case tyConDataCons (classTyCon clas) of
 532                       (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
 533 \end{code}
 534
 535 %************************************************************************
 536 %*                                                                      *
 537 \subsection{Splitting products}
 538 %*                                                                      *
 539 %************************************************************************
 540
 541 \begin{code}
 542 splitProductType_maybe
 543         :: Type                         -- A product type, perhaps
 544         -> Maybe (TyCon,                -- The type constructor
 545                   [Type],               -- Type args of the tycon
 546                   DataCon,              -- The data constructor
 547                   [Type])               -- Its *representation* arg types
 548
 549         -- Returns (Just ...) for any
 550         --      concrete (i.e. constructors visible)
 551         --      single-constructor
 552         --      not existentially quantified
 553         -- type whether a data type or a new type
 554         --
 555         -- Rejecing existentials is conservative.  Maybe some things
 556         -- could be made to work with them, but I'm not going to sweat
 557         -- it through till someone finds it's important.
 558
 559 splitProductType_maybe ty
 560   = case splitTyConApp_maybe ty of
 561         Just (tycon,ty_args)
 562            | isProductTyCon tycon       -- Includes check for non-existential,
 563                                         -- and for constructors visible
 564            -> Just (tycon, ty_args, data_con, dataConArgTys data_con ty_args)
 565            where
 566               data_con = head (tyConDataCons tycon)
 567         other -> Nothing
 568
 569 splitProductType str ty
 570   = case splitProductType_maybe ty of
 571         Just stuff -> stuff
 572         Nothing    -> pprPanic (str ++ ": not a product") (pprType ty)
 573
 574
 575 computeRep :: [StrictnessMark]          -- Original arg strictness
 576            -> [Type]                    -- and types
 577            -> ([StrictnessMark],        -- Representation arg strictness
 578                [Type])                  -- And type
 579
 580 computeRep stricts tys
 581   = unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
 582   where
 583     unbox NotMarkedStrict ty = [(NotMarkedStrict, ty)]
 584     unbox MarkedStrict    ty = [(MarkedStrict,    ty)]
 585     unbox MarkedUnboxed   ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
 586                              where
 587                                (_, _, arg_dc, arg_tys) = splitProductType "unbox_strict_arg_ty" ty
 588 \end{code}