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