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