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