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