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         dataConType, dataConSig, dataConName, dataConTag,
  12         dataConOrigArgTys, dataConArgTys, dataConRawArgTys, dataConTyCon,
  13         dataConFieldLabels, dataConStrictMarks, dataConSourceArity,
  14         dataConNumFields, dataConNumInstArgs, dataConId,
  15         isNullaryDataCon, isTupleCon, isUnboxedTupleCon,
  16         isExistentialDataCon
  17     ) where
  18
  19 #include "HsVersions.h"
  20
  21 import CmdLineOpts      ( opt_DictsStrict )
  22 import TysPrim
  23 import Type             ( Type, ThetaType, TauType,
  24                           mkSigmaTy, mkFunTys, mkTyConApp,
  25                           mkTyVarTys, mkDictTy, substTy,
  26                           splitAlgTyConApp_maybe
  27                         )
  28 import PprType
  29 import TyCon            ( TyCon, tyConDataCons, isDataTyCon,
  30                           isTupleTyCon, isUnboxedTupleTyCon )
  31 import Class            ( classTyCon )
  32 import Name             ( Name, NamedThing(..), nameUnique, isLocallyDefinedName )
  33 import Var              ( TyVar, Id )
  34 import VarEnv
  35 import FieldLabel       ( FieldLabel )
  36 import BasicTypes       ( StrictnessMark(..), Arity )
  37 import Outputable
  38 import Unique           ( Unique, Uniquable(..) )
  39 import CmdLineOpts      ( opt_UnboxStrictFields )
  40 import UniqSet
  41 import Maybe
  42 import Util             ( assoc )
  43 \end{code}
  44
  45
  46 %************************************************************************
  47 %*                                                                      *
  48 \subsection{Data constructors}
  49 %*                                                                      *
  50 %************************************************************************
  51
  52 \begin{code}
  53 data DataCon
  54   = MkData {                    -- Used for data constructors only;
  55                                 -- there *is* no constructor for a newtype
  56         dcName   :: Name,
  57         dcUnique :: Unique,             -- Cached from Name
  58         dcTag    :: ConTag,
  59
  60         -- Running example:
  61         --
  62         --      data Eq a => T a = forall b. Ord b => MkT a [b]
  63
  64         dcType   :: Type,       -- Type of the constructor
  65                                 --      forall ab . Ord b => a -> [b] -> MkT a
  66                                 -- (this is *not* of the constructor Id:
  67                                 --  see notes after this data type declaration)
  68
  69         -- The next six fields express the type of the constructor, in pieces
  70         -- e.g.
  71         --
  72         --      dcTyVars   = [a]
  73         --      dcTheta    = [Eq a]
  74         --      dcExTyVars = [b]
  75         --      dcExTheta  = [Ord b]
  76         --      dcOrigArgTys   = [a,List b]
  77         --      dcTyCon    = T
  78
  79         dcTyVars :: [TyVar],            -- Type vars and context for the data type decl
  80         dcTheta  ::  ThetaType,
  81
  82         dcExTyVars :: [TyVar],          -- Ditto for the context of the constructor,
  83         dcExTheta  :: ThetaType,        -- the existentially quantified stuff
  84
  85         dcOrigArgTys :: [Type],         -- Original argument types
  86                                         -- (before unboxing and flattening of
  87                                         --  strict fields)
  88         dcRepArgTys :: [Type],          -- Constructor Argument types
  89         dcTyCon  :: TyCon,              -- Result tycon
  90
  91         -- Now the strictness annotations and field labels of the constructor
  92         dcUserStricts :: [StrictnessMark],
  93                 -- Strictness annotations, as placed on the data type defn,
  94                 -- in the same order as the argument types;
  95                 -- length = dataConNumFields dataCon
  96
  97         dcRealStricts :: [StrictnessMark],
  98                 -- Strictness annotations as deduced by the compiler.  May
  99                 -- include some MarkedUnboxed fields that are MarkedStrict
 100                 -- in dcUserStricts.
 101                 -- length = dataConNumFields dataCon
 102
 103         dcFields  :: [FieldLabel],
 104                 -- Field labels for this constructor, in the
 105                 -- same order as the argument types;
 106                 -- length = 0 (if not a record) or dataConSourceArity.
 107
 108         -- Finally, the curried function that corresponds to the constructor
 109         --      mkT :: forall a b. (Eq a, Ord b) => a -> [b] -> T a
 110         --      mkT = /\ab. \deq dord p qs. Con MkT [a, b, dord, p, qs]
 111         -- This unfolding is built in MkId.mkDataConId
 112
 113         dcId :: Id                      -- The corresponding Id
 114   }
 115
 116 type ConTag = Int
 117
 118 fIRST_TAG :: ConTag
 119 fIRST_TAG =  1  -- Tags allocated from here for real constructors
 120 \end{code}
 121
 122 The dcType field contains the type of the representation of a contructor
 123 This may differ from the type of the contructor *Id* (built
 124 by MkId.mkDataConId) for two reasons:
 125         a) the constructor Id may be overloaded, but the dictionary isn't stored
 126            e.g.    data Eq a => T a = MkT a a
 127
 128         b) the constructor may store an unboxed version of a strict field.
 129
 130 Here's an example illustrating both:
 131         data Ord a => T a = MkT Int! a
 132 Here
 133         T :: Ord a => Int -> a -> T a
 134 but the rep type is
 135         Trep :: Int# -> a -> T a
 136 Actually, the unboxed part isn't implemented yet!
 137
 138
 139 \begin{code}
 140 instance Eq DataCon where
 141     a == b = getUnique a == getUnique b
 142     a /= b = getUnique a /= getUnique b
 143
 144 instance Ord DataCon where
 145     a <= b = getUnique a <= getUnique b
 146     a <  b = getUnique a <  getUnique b
 147     a >= b = getUnique a >= getUnique b
 148     a >  b = getUnique a > getUnique b
 149     compare a b = getUnique a `compare` getUnique b
 150
 151 instance Uniquable DataCon where
 152     getUnique = dcUnique
 153
 154 instance NamedThing DataCon where
 155     getName = dcName
 156
 157 instance Outputable DataCon where
 158     ppr con = ppr (dataConName con)
 159
 160 instance Show DataCon where
 161     showsPrec p con = showsPrecSDoc p (ppr con)
 162 \end{code}
 163
 164 \begin{code}
 165 mkDataCon :: Name
 166           -> [StrictnessMark] -> [FieldLabel]
 167           -> [TyVar] -> ThetaType
 168           -> [TyVar] -> ThetaType
 169           -> [TauType] -> TyCon
 170           -> Id
 171           -> DataCon
 172   -- Can get the tag from the TyCon
 173
 174 mkDataCon name arg_stricts fields tyvars theta ex_tyvars ex_theta orig_arg_tys tycon id
 175   = ASSERT(length arg_stricts == length orig_arg_tys)
 176         -- The 'stricts' passed to mkDataCon are simply those for the
 177         -- source-language arguments.  We add extra ones for the
 178         -- dictionary arguments right here.
 179     con
 180   where
 181     con = MkData {dcName = name, dcUnique = nameUnique name,
 182                   dcTyVars = tyvars, dcTheta = theta,
 183                   dcOrigArgTys = orig_arg_tys,
 184                   dcRepArgTys = rep_arg_tys,
 185                   dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
 186                   dcRealStricts = all_stricts, dcUserStricts = user_stricts,
 187                   dcFields = fields, dcTag = tag, dcTyCon = tycon, dcType = ty,
 188                   dcId = id}
 189
 190     (real_arg_stricts, strict_arg_tyss)
 191         = unzip (zipWith (unbox_strict_arg_ty tycon) arg_stricts orig_arg_tys)
 192     rep_arg_tys = concat strict_arg_tyss
 193
 194     all_stricts = (map mk_dict_strict_mark ex_theta) ++ real_arg_stricts
 195     user_stricts = (map mk_dict_strict_mark ex_theta) ++ arg_stricts
 196         -- Add a strictness flag for the existential dictionary arguments
 197
 198     tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
 199     ty  = mkSigmaTy (tyvars ++ ex_tyvars)
 200                     ex_theta
 201                     (mkFunTys rep_arg_tys
 202                         (mkTyConApp tycon (mkTyVarTys tyvars)))
 203
 204 mk_dict_strict_mark (clas,tys)
 205   | opt_DictsStrict &&
 206         -- Don't mark newtype things as strict!
 207     isDataTyCon (classTyCon clas) = MarkedStrict
 208   | otherwise                     = NotMarkedStrict
 209
 210 -- We attempt to unbox/unpack a strict field when either:
 211 --   (i)  The tycon is imported, and the field is marked '! !', or
 212 --   (ii) The tycon is defined in this module, the field is marked '!',
 213 --        and the -funbox-strict-fields flag is on.
 214 --
 215 -- This ensures that if we compile some modules with -funbox-strict-fields and
 216 -- some without, the compiler doesn't get confused about the constructor
 217 -- representations.
 218
 219 unbox_strict_arg_ty :: TyCon -> StrictnessMark -> Type -> (StrictnessMark, [Type])
 220 unbox_strict_arg_ty tycon NotMarkedStrict ty
 221   = (NotMarkedStrict, [ty])
 222 unbox_strict_arg_ty tycon MarkedStrict ty
 223   | not opt_UnboxStrictFields
 224   || not (isLocallyDefinedName (getName tycon)) = (MarkedStrict, [ty])
 225 unbox_strict_arg_ty tycon marked_unboxed ty
 226   -- MarkedUnboxed || (MarkedStrict && opt_UnboxStrictFields && not imported)
 227   = case splitAlgTyConApp_maybe ty of
 228         Just (tycon,_,[])
 229            -> panic (showSDoc (hcat [
 230                         text "unbox_strict_arg_ty: constructors for ",
 231                         ppr tycon,
 232                         text " not available."
 233                      ]))
 234         Just (tycon,ty_args,[con])
 235            -> case maybe_unpack_fields emptyUniqSet
 236                      (zip (dataConOrigArgTys con ty_args)
 237                           (dcUserStricts con))
 238               of
 239                  Nothing  -> (MarkedStrict, [ty])
 240                  Just tys -> (MarkedUnboxed con tys, tys)
 241         _ -> (MarkedStrict, [ty])
 242
 243 -- bail out if we encounter the same tycon twice.  This avoids problems like
 244 --
 245 --   data A = !B
 246 --   data B = !A
 247 --
 248 -- where no useful unpacking can be done.
 249
 250 maybe_unpack_field :: UniqSet TyCon -> Type -> StrictnessMark -> Maybe [Type]
 251 maybe_unpack_field set ty NotMarkedStrict
 252   = Just [ty]
 253 maybe_unpack_field set ty MarkedStrict | not opt_UnboxStrictFields
 254   = Just [ty]
 255 maybe_unpack_field set ty strict
 256   = case splitAlgTyConApp_maybe ty of
 257         Just (tycon,ty_args,[con])
 258            | tycon `elementOfUniqSet` set -> Nothing
 259            | otherwise ->
 260                 let set' = addOneToUniqSet set tycon in
 261                 maybe_unpack_fields set'
 262                     (zip (dataConOrigArgTys con ty_args)
 263                          (dcUserStricts con))
 264         _ -> Just [ty]
 265
 266 maybe_unpack_fields :: UniqSet TyCon -> [(Type,StrictnessMark)] -> Maybe [Type]
 267 maybe_unpack_fields set tys
 268   | all isJust unpacked_fields = Just (concat (catMaybes unpacked_fields))
 269   | otherwise = Nothing
 270   where unpacked_fields = map (\(ty,str) -> maybe_unpack_field set ty str) tys
 271 \end{code}
 272
 273
 274 \begin{code}
 275 dataConName :: DataCon -> Name
 276 dataConName = dcName
 277
 278 dataConTag :: DataCon -> ConTag
 279 dataConTag  = dcTag
 280
 281 dataConTyCon :: DataCon -> TyCon
 282 dataConTyCon = dcTyCon
 283
 284 dataConType :: DataCon -> Type
 285 dataConType = dcType
 286
 287 dataConId :: DataCon -> Id
 288 dataConId = dcId
 289
 290
 291 dataConFieldLabels :: DataCon -> [FieldLabel]
 292 dataConFieldLabels = dcFields
 293
 294 dataConStrictMarks :: DataCon -> [StrictnessMark]
 295 dataConStrictMarks = dcRealStricts
 296
 297 dataConRawArgTys :: DataCon -> [TauType] -- a function of convenience
 298 dataConRawArgTys = dcRepArgTys
 299
 300 dataConSourceArity :: DataCon -> Arity
 301         -- Source-level arity of the data constructor
 302 dataConSourceArity dc = length (dcOrigArgTys dc)
 303
 304 dataConSig :: DataCon -> ([TyVar], ThetaType,
 305                           [TyVar], ThetaType,
 306                           [TauType], 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, dataConOrigArgTys :: 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
 320 dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
 321                        dcExTyVars = ex_tyvars, dcExTheta = ex_theta}) inst_tys
 322  = map (substTy (zipVarEnv (tyvars ++ ex_tyvars) inst_tys))
 323        ([mkDictTy cls tys | (cls,tys) <- ex_theta] ++ arg_tys)
 324
 325 dataConOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars,
 326                        dcExTyVars = ex_tyvars, dcExTheta = ex_theta}) inst_tys
 327  = map (substTy (zipVarEnv (tyvars ++ ex_tyvars) inst_tys))
 328        ([mkDictTy cls tys | (cls,tys) <- ex_theta] ++ arg_tys)
 329 \end{code}
 330
 331 dataConNumFields gives the number of actual fields in the
 332 {\em representation} of the data constructor.  This may be more than appear
 333 in the source code; the extra ones are the existentially quantified
 334 dictionaries
 335
 336 \begin{code}
 337 -- Number of type-instantiation arguments
 338 -- All the remaining arguments of the DataCon are (notionally)
 339 -- stored in the DataCon, and are matched in a case expression
 340 dataConNumInstArgs (MkData {dcTyVars = tyvars}) = length tyvars
 341
 342 dataConNumFields (MkData {dcExTheta = theta, dcRepArgTys = arg_tys})
 343   = length theta + length arg_tys
 344
 345 isNullaryDataCon con
 346   = dataConNumFields con == 0 -- function of convenience
 347
 348 isTupleCon :: DataCon -> Bool
 349 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
 350
 351 isUnboxedTupleCon :: DataCon -> Bool
 352 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
 353
 354 isExistentialDataCon :: DataCon -> Bool
 355 isExistentialDataCon (MkData {dcExTyVars = tvs}) = not (null tvs)
 356 \end{code}