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