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, equalLength, 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
 155
 156 %************************************************************************
 157 %*                                                                      *
 158 \subsection{Data constructors}
 159 %*                                                                      *
 160 %************************************************************************
 161
 162 \begin{code}
 163 data DataCon
 164   = MkData {                    -- Used for data constructors only;
 165                                 -- there *is* no constructor for a newtype
 166         dcName    :: Name,
 167
 168         dcUnique :: Unique,             -- Cached from Name
 169         dcTag    :: ConTag,
 170
 171         -- Running example:
 172         --
 173         --      data Eq a => T a = forall b. Ord b => MkT a [b]
 174
 175         dcRepType   :: Type,    -- Type of the constructor
 176                                 --      forall a b . Ord b => a -> [b] -> MkT a
 177                                 -- (this is *not* of the constructor wrapper Id:
 178                                 --  see notes after this data type declaration)
 179                                 --
 180         -- Notice that the existential type parameters come *second*.
 181         -- Reason: in a case expression we may find:
 182         --      case (e :: T t) of { MkT b (d:Ord b) (x:t) (xs:[b]) -> ... }
 183         -- It's convenient to apply the rep-type of MkT to 't', to get
 184         --      forall b. Ord b => ...
 185         -- and use that to check the pattern.  Mind you, this is really only
 186         -- use in CoreLint.
 187
 188
 189         -- The next six fields express the type of the constructor, in pieces
 190         -- e.g.
 191         --
 192         --      dcTyVars   = [a]
 193         --      dcTheta    = [Eq a]
 194         --      dcExTyVars = [b]
 195         --      dcExTheta  = [Ord b]
 196         --      dcOrigArgTys   = [a,List b]
 197         --      dcTyCon    = T
 198
 199         dcTyVars :: [TyVar],            -- Type vars for the data type decl
 200                                         -- These are ALWAYS THE SAME AS THE TYVARS
 201                                         -- FOR THE PARENT TyCon.  We occasionally rely on
 202                                         -- this just to avoid redundant instantiation
 203
 204         dcStupidTheta  ::  ThetaType,   -- This is a "thinned" version of the context of
 205                                         -- the data decl.
 206                 -- "Thinned", because the Report says
 207                 -- to eliminate any constraints that don't mention
 208                 -- tyvars free in the arg types for this constructor
 209                 --
 210                 -- "Stupid", because the dictionaries aren't used for anything.
 211                 --
 212                 -- Indeed, [as of March 02] they are no
 213                 -- longer in the type of the dcWrapId, because
 214                 -- that makes it harder to use the wrap-id to rebuild
 215                 -- values after record selection or in generics.
 216
 217         dcExTyVars :: [TyVar],          -- Ditto for the context of the constructor,
 218         dcExTheta  :: ThetaType,        -- the existentially quantified stuff
 219
 220         dcOrigArgTys :: [Type],         -- Original argument types
 221                                         -- (before unboxing and flattening of
 222                                         --  strict fields)
 223
 224         dcRepArgTys :: [Type],          -- Final, representation argument types, after unboxing and flattening,
 225                                         -- and including existential dictionaries
 226
 227         dcRepStrictness :: [StrictnessMark],    -- One for each representation argument
 228
 229         dcTyCon  :: TyCon,              -- Result tycon
 230
 231         -- Now the strictness annotations and field labels of the constructor
 232         dcStrictMarks :: [StrictnessMark],
 233                 -- Strictness annotations as deduced by the compiler.
 234                 -- Has no MarkedUserStrict; they have been changed to MarkedStrict
 235                 -- or MarkedUnboxed by the compiler.
 236                 -- *Includes the existential dictionaries*
 237                 -- length = length dcExTheta + dataConSourceArity dataCon
 238
 239         dcFields  :: [FieldLabel],
 240                 -- Field labels for this constructor, in the
 241                 -- same order as the argument types;
 242                 -- length = 0 (if not a record) or dataConSourceArity.
 243
 244         -- Finally, the curried worker function that corresponds to the constructor
 245         -- It doesn't have an unfolding; the code generator saturates these Ids
 246         -- and allocates a real constructor when it finds one.
 247         --
 248         -- An entirely separate wrapper function is built in TcTyDecls
 249
 250         dcWorkId :: Id,         -- The corresponding worker Id
 251                                 -- Takes dcRepArgTys as its arguments
 252                                 -- Perhaps this should be a 'Maybe'; not reqd for newtype constructors
 253
 254         dcWrapId :: Maybe Id    -- The wrapper Id, if it's necessary
 255                                 -- It's deemed unnecessary if it performs the
 256                                 -- identity function
 257   }
 258
 259 type ConTag = Int
 260
 261 fIRST_TAG :: ConTag
 262 fIRST_TAG =  1  -- Tags allocated from here for real constructors
 263 \end{code}
 264
 265 The dcRepType field contains the type of the representation of a contructor
 266 This may differ from the type of the contructor *Id* (built
 267 by MkId.mkDataConId) for two reasons:
 268         a) the constructor Id may be overloaded, but the dictionary isn't stored
 269            e.g.    data Eq a => T a = MkT a a
 270
 271         b) the constructor may store an unboxed version of a strict field.
 272
 273 Here's an example illustrating both:
 274         data Ord a => T a = MkT Int! a
 275 Here
 276         T :: Ord a => Int -> a -> T a
 277 but the rep type is
 278         Trep :: Int# -> a -> T a
 279 Actually, the unboxed part isn't implemented yet!
 280
 281
 282 %************************************************************************
 283 %*                                                                      *
 284 \subsection{Instances}
 285 %*                                                                      *
 286 %************************************************************************
 287
 288 \begin{code}
 289 instance Eq DataCon where
 290     a == b = getUnique a == getUnique b
 291     a /= b = getUnique a /= getUnique b
 292
 293 instance Ord DataCon where
 294     a <= b = getUnique a <= getUnique b
 295     a <  b = getUnique a <  getUnique b
 296     a >= b = getUnique a >= getUnique b
 297     a >  b = getUnique a > getUnique b
 298     compare a b = getUnique a `compare` getUnique b
 299
 300 instance Uniquable DataCon where
 301     getUnique = dcUnique
 302
 303 instance NamedThing DataCon where
 304     getName = dcName
 305
 306 instance Outputable DataCon where
 307     ppr con = ppr (dataConName con)
 308
 309 instance Show DataCon where
 310     showsPrec p con = showsPrecSDoc p (ppr con)
 311 \end{code}
 312
 313
 314 %************************************************************************
 315 %*                                                                      *
 316 \subsection{Construction}
 317 %*                                                                      *
 318 %************************************************************************
 319
 320 \begin{code}
 321 mkDataCon :: Name
 322           -> [StrictnessMark] -> [FieldLabel]
 323           -> [TyVar] -> ThetaType
 324           -> [TyVar] -> ThetaType
 325           -> [Type] -> TyCon
 326           -> Id -> Maybe Id     -- Worker and possible wrapper
 327           -> DataCon
 328   -- Can get the tag from the TyCon
 329
 330 mkDataCon name
 331           arg_stricts   -- Use [] to mean 'all non-strict'
 332           fields
 333           tyvars theta ex_tyvars ex_theta orig_arg_tys tycon
 334           work_id wrap_id
 335   = con
 336   where
 337     con = MkData {dcName = name,
 338                   dcUnique = nameUnique name,
 339                   dcTyVars = tyvars, dcStupidTheta = theta,
 340                   dcOrigArgTys = orig_arg_tys,
 341                   dcRepArgTys = rep_arg_tys,
 342                   dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
 343                   dcStrictMarks = real_stricts, dcRepStrictness = rep_arg_stricts,
 344                   dcFields = fields, dcTag = tag, dcTyCon = tycon, dcRepType = ty,
 345                   dcWorkId = work_id, dcWrapId = wrap_id}
 346
 347         -- Strictness marks for source-args
 348         --      *after unboxing choices*,
 349         -- but  *including existential dictionaries*
 350         --
 351         -- The 'arg_stricts' passed to mkDataCon are simply those for the
 352         -- source-language arguments.  We add extra ones for the
 353         -- dictionary arguments right here.
 354     ex_dict_tys  = mkPredTys ex_theta
 355     real_stricts = map mk_dict_strict_mark ex_dict_tys ++
 356                    zipWith (chooseBoxingStrategy tycon)
 357                            orig_arg_tys
 358                            (arg_stricts ++ repeat NotMarkedStrict)
 359     real_arg_tys = ex_dict_tys ++ orig_arg_tys
 360
 361         -- Representation arguments and demands
 362     (rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
 363
 364     tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
 365     ty  = mkForAllTys (tyvars ++ ex_tyvars)
 366                       (mkFunTys rep_arg_tys result_ty)
 367                 -- NB: the existential dict args are already in rep_arg_tys
 368
 369     result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
 370
 371 mk_dict_strict_mark ty | isStrictType ty = MarkedStrict
 372                        | otherwise       = NotMarkedStrict
 373 \end{code}
 374
 375 \begin{code}
 376 dataConName :: DataCon -> Name
 377 dataConName = dcName
 378
 379 dataConTag :: DataCon -> ConTag
 380 dataConTag  = dcTag
 381
 382 dataConTyCon :: DataCon -> TyCon
 383 dataConTyCon = dcTyCon
 384
 385 dataConRepType :: DataCon -> Type
 386 dataConRepType = dcRepType
 387
 388 dataConWorkId :: DataCon -> Id
 389 dataConWorkId = dcWorkId
 390
 391 dataConWrapId_maybe :: DataCon -> Maybe Id
 392 dataConWrapId_maybe = dcWrapId
 393
 394 dataConWrapId :: DataCon -> Id
 395 -- Returns an Id which looks like the Haskell-source constructor
 396 -- If there is no dcWrapId it's because there is no need for a
 397 -- wrapper, so the worker is the Right Thing
 398 dataConWrapId dc = dcWrapId dc `orElse` dcWorkId dc
 399
 400 dataConFieldLabels :: DataCon -> [FieldLabel]
 401 dataConFieldLabels = dcFields
 402
 403 dataConStrictMarks :: DataCon -> [StrictnessMark]
 404 dataConStrictMarks = dcStrictMarks
 405
 406 -- Number of type-instantiation arguments
 407 -- All the remaining arguments of the DataCon are (notionally)
 408 -- stored in the DataCon, and are matched in a case expression
 409 dataConNumInstArgs (MkData {dcTyVars = tyvars}) = length tyvars
 410
 411 dataConSourceArity :: DataCon -> Arity
 412         -- Source-level arity of the data constructor
 413 dataConSourceArity dc = length (dcOrigArgTys dc)
 414
 415 -- dataConRepArity gives the number of actual fields in the
 416 -- {\em representation} of the data constructor.  This may be more than appear
 417 -- in the source code; the extra ones are the existentially quantified
 418 -- dictionaries
 419 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
 420
 421 isNullaryDataCon con  = dataConRepArity con == 0
 422
 423 dataConRepStrictness :: DataCon -> [StrictnessMark]
 424         -- Give the demands on the arguments of a
 425         -- Core constructor application (Con dc args)
 426 dataConRepStrictness dc = dcRepStrictness dc
 427
 428 dataConSig :: DataCon -> ([TyVar], ThetaType,
 429                           [TyVar], ThetaType,
 430                           [Type], TyCon)
 431
 432 dataConSig (MkData {dcTyVars = tyvars, dcStupidTheta = theta,
 433                      dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
 434                      dcOrigArgTys = arg_tys, dcTyCon = tycon})
 435   = (tyvars, theta, ex_tyvars, ex_theta, arg_tys, tycon)
 436
 437 dataConArgTys :: DataCon
 438               -> [Type]         -- Instantiated at these types
 439                                 -- NB: these INCLUDE the existentially quantified arg types
 440               -> [Type]         -- Needs arguments of these types
 441                                 -- NB: these INCLUDE the existentially quantified dict args
 442                                 --     but EXCLUDE the data-decl context which is discarded
 443                                 -- It's all post-flattening etc; this is a representation type
 444
 445 dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
 446                        dcExTyVars = ex_tyvars}) inst_tys
 447  = map (substTyWith (tyvars ++ ex_tyvars) inst_tys) arg_tys
 448
 449 dataConTheta :: DataCon -> ThetaType
 450 dataConTheta dc = dcStupidTheta dc
 451
 452 dataConExistentialTyVars :: DataCon -> [TyVar]
 453 dataConExistentialTyVars dc = dcExTyVars dc
 454
 455 -- And the same deal for the original arg tys:
 456
 457 dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
 458 dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars,
 459                        dcExTyVars = ex_tyvars}) inst_tys
 460  = map (substTyWith (tyvars ++ ex_tyvars) inst_tys) arg_tys
 461 \end{code}
 462
 463 These two functions get the real argument types of the constructor,
 464 without substituting for any type variables.
 465
 466 dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
 467
 468 dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
 469 after any flattening has been done.
 470
 471 \begin{code}
 472 dataConOrigArgTys :: DataCon -> [Type]
 473 dataConOrigArgTys dc = dcOrigArgTys dc
 474
 475 dataConRepArgTys :: DataCon -> [Type]
 476 dataConRepArgTys dc = dcRepArgTys dc
 477 \end{code}
 478
 479
 480 \begin{code}
 481 isTupleCon :: DataCon -> Bool
 482 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
 483
 484 isUnboxedTupleCon :: DataCon -> Bool
 485 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
 486
 487 isExistentialDataCon :: DataCon -> Bool
 488 isExistentialDataCon (MkData {dcExTyVars = tvs}) = notNull tvs
 489 \end{code}
 490
 491
 492 \begin{code}
 493 classDataCon :: Class -> DataCon
 494 classDataCon clas = case tyConDataCons (classTyCon clas) of
 495                       (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
 496 \end{code}
 497
 498 %************************************************************************
 499 %*                                                                      *
 500 \subsection{Splitting products}
 501 %*                                                                      *
 502 %************************************************************************
 503
 504 \begin{code}
 505 splitProductType_maybe
 506         :: Type                         -- A product type, perhaps
 507         -> Maybe (TyCon,                -- The type constructor
 508                   [Type],               -- Type args of the tycon
 509                   DataCon,              -- The data constructor
 510                   [Type])               -- Its *representation* arg types
 511
 512         -- Returns (Just ...) for any
 513         --      concrete (i.e. constructors visible)
 514         --      single-constructor
 515         --      not existentially quantified
 516         -- type whether a data type or a new type
 517         --
 518         -- Rejecing existentials is conservative.  Maybe some things
 519         -- could be made to work with them, but I'm not going to sweat
 520         -- it through till someone finds it's important.
 521
 522 splitProductType_maybe ty
 523   = case splitTyConApp_maybe ty of
 524         Just (tycon,ty_args)
 525            | isProductTyCon tycon       -- Includes check for non-existential,
 526                                         -- and for constructors visible
 527            -> Just (tycon, ty_args, data_con, dataConArgTys data_con ty_args)
 528            where
 529               data_con = head (tyConDataCons tycon)
 530         other -> Nothing
 531
 532 splitProductType str ty
 533   = case splitProductType_maybe ty of
 534         Just stuff -> stuff
 535         Nothing    -> pprPanic (str ++ ": not a product") (pprType ty)
 536
 537 -- We attempt to unbox/unpack a strict field when either:
 538 --   (i)  The tycon is imported, and the field is marked '! !', or
 539 --   (ii) The tycon is defined in this module, the field is marked '!',
 540 --        and the -funbox-strict-fields flag is on.
 541 --
 542 -- This ensures that if we compile some modules with -funbox-strict-fields and
 543 -- some without, the compiler doesn't get confused about the constructor
 544 -- representations.
 545
 546 chooseBoxingStrategy :: TyCon -> Type -> StrictnessMark -> StrictnessMark
 547         -- Transforms any MarkedUserStricts into MarkUnboxed or MarkedStrict
 548 chooseBoxingStrategy tycon arg_ty strict
 549   = case strict of
 550         MarkedUserStrict
 551           | opt_UnboxStrictFields
 552                 && unbox arg_ty -> MarkedUnboxed
 553           | otherwise -> MarkedStrict
 554         other -> strict
 555   where
 556         -- beware: repType will go into a loop if we try this on a recursive
 557         -- type (for reasons unknown...), hence the check for recursion below.
 558     unbox ty =
 559         case splitTyConApp_maybe ty of
 560                 Nothing -> False
 561                 Just (arg_tycon, _)
 562                   | isRecursiveTyCon arg_tycon -> False
 563                   | otherwise ->
 564                           case splitTyConApp_maybe (repType ty) of
 565                                 Nothing -> False
 566                                 Just (arg_tycon, _) -> isProductTyCon arg_tycon
 567
 568 computeRep :: [StrictnessMark]          -- Original arg strictness
 569                                         --   [after strategy choice; can't be MarkedUserStrict]
 570            -> [Type]                    -- and types
 571            -> ([StrictnessMark],        -- Representation arg strictness
 572                [Type])                  -- And type
 573
 574 computeRep stricts tys
 575   = unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
 576   where
 577     unbox NotMarkedStrict ty = [(NotMarkedStrict, ty)]
 578     unbox MarkedStrict    ty = [(MarkedStrict,    ty)]
 579     unbox MarkedUnboxed   ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
 580                              where
 581                                (_, _, arg_dc, arg_tys) = splitProductType "unbox_strict_arg_ty" (repType ty)
 582 \end{code}