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