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