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