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