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