ghc/compiler/basicTypes/DataCon.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
   3 %
   4 \section[Literal]{@Literal@: Machine literals (unboxed, of course)}
   5
   6 \begin{code}
   7 module DataCon (
   8         DataCon,
   9         ConTag, fIRST_TAG,
  10         mkDataCon,
  11         dataConType, dataConSig, dataConName, dataConTag,
  12         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                         )
  27 import TyCon            ( TyCon, tyConDataCons, isDataTyCon,
  28                           isTupleTyCon, isUnboxedTupleTyCon )
  29 import Class            ( classTyCon )
  30 import Name             ( Name, NamedThing(..), nameUnique )
  31 import Var              ( TyVar, Id )
  32 import VarEnv
  33 import FieldLabel       ( FieldLabel )
  34 import BasicTypes       ( StrictnessMark(..), Arity )
  35 import Outputable
  36 import Unique           ( Unique, Uniquable(..) )
  37 import Util             ( assoc )
  38 \end{code}
  39
  40
  41 %************************************************************************
  42 %*                                                                      *
  43 \subsection{Data constructors}
  44 %*                                                                      *
  45 %************************************************************************
  46
  47 \begin{code}
  48 data DataCon
  49   = MkData {                    -- Used for data constructors only;
  50                                 -- there *is* no constructor for a newtype
  51         dcName   :: Name,
  52         dcUnique :: Unique,             -- Cached from Name
  53         dcTag    :: ConTag,
  54         dcType   :: Type,               -- Type of the constructor (see notes below)
  55
  56         dcTyVars :: [TyVar],            -- Type vars and context for the data type decl
  57         dcTheta  ::  ThetaType,
  58
  59         dcExTyVars :: [TyVar],          -- Ditto for the context of the constructor,
  60         dcExTheta  :: ThetaType,        -- the existentially quantified stuff
  61
  62         dcArgTys :: [Type],             -- Argument types
  63         dcTyCon  :: TyCon,              -- Result tycon
  64
  65         dcStricts :: [StrictnessMark],  -- Strict args, in the same order as the argument types;
  66                                         -- length = dataConNumFields dataCon
  67
  68         dcFields  :: [FieldLabel],      -- Field labels for this constructor, in the
  69                                         -- same order as the argument types;
  70                                         -- length = 0 (if not a record) or dataConSourceArity.
  71
  72         dcId :: Id                      -- The corresponding Id
  73   }
  74
  75 type ConTag = Int
  76
  77 fIRST_TAG :: ConTag
  78 fIRST_TAG =  1  -- Tags allocated from here for real constructors
  79 \end{code}
  80
  81 The dcType field contains the type of the representation of a contructor
  82 This may differ from the type of the contructor *Id* (built
  83 by MkId.mkDataConId) for two reasons:
  84         a) the constructor Id may be overloaded, but the dictionary isn't stored
  85            e.g.    data Eq a => T a = MkT a a
  86
  87         b) the constructor may store an unboxed version of a strict field.
  88
  89 Here's an example illustrating both:
  90         data Ord a => T a = MkT Int! a
  91 Here
  92         T :: Ord a => Int -> a -> T a
  93 but the rep type is
  94         Trep :: Int# -> a -> T a
  95 Actually, the unboxed part isn't implemented yet!
  96
  97
  98 \begin{code}
  99 instance Eq DataCon where
 100     a == b = getUnique a == getUnique b
 101     a /= b = getUnique a /= getUnique b
 102
 103 instance Ord DataCon where
 104     a <= b = getUnique a <= getUnique b
 105     a <  b = getUnique a <  getUnique b
 106     a >= b = getUnique a >= getUnique b
 107     a >  b = getUnique a > getUnique b
 108     compare a b = getUnique a `compare` getUnique b
 109
 110 instance Uniquable DataCon where
 111     getUnique = dcUnique
 112
 113 instance NamedThing DataCon where
 114     getName = dcName
 115
 116 instance Outputable DataCon where
 117     ppr con = ppr (dataConName con)
 118
 119 instance Show DataCon where
 120     showsPrec p con = showsPrecSDoc p (ppr con)
 121 \end{code}
 122
 123 \begin{code}
 124 mkDataCon :: Name
 125           -> [StrictnessMark] -> [FieldLabel]
 126           -> [TyVar] -> ThetaType
 127           -> [TyVar] -> ThetaType
 128           -> [TauType] -> TyCon
 129           -> Id
 130           -> DataCon
 131   -- Can get the tag from the TyCon
 132
 133 mkDataCon name arg_stricts fields tyvars theta ex_tyvars ex_theta arg_tys tycon id
 134   = ASSERT(length arg_stricts == length arg_tys)
 135         -- The 'stricts' passed to mkDataCon are simply those for the
 136         -- source-language arguments.  We add extra ones for the
 137         -- dictionary arguments right here.
 138     con
 139   where
 140     con = MkData {dcName = name, dcUnique = nameUnique name,
 141                   dcTyVars = tyvars, dcTheta = theta, dcArgTys = arg_tys,
 142                   dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
 143                   dcStricts = all_stricts, dcFields = fields,
 144                   dcTag = tag, dcTyCon = tycon, dcType = ty,
 145                   dcId = id}
 146
 147     all_stricts = (map mk_dict_strict_mark ex_theta) ++ arg_stricts
 148         -- Add a strictness flag for the existential dictionary arguments
 149
 150     tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
 151     ty  = mkSigmaTy (tyvars ++ ex_tyvars)
 152                     ex_theta
 153                     (mkFunTys arg_tys (mkTyConApp tycon (mkTyVarTys tyvars)))
 154
 155 mk_dict_strict_mark (clas,tys)
 156   | opt_DictsStrict &&
 157     isDataTyCon (classTyCon clas) = MarkedStrict        -- Don't mark newtype things as strict!
 158   | otherwise                     = NotMarkedStrict
 159 \end{code}
 160
 161
 162 \begin{code}
 163 dataConName :: DataCon -> Name
 164 dataConName = dcName
 165
 166 dataConTag :: DataCon -> ConTag
 167 dataConTag  = dcTag
 168
 169 dataConTyCon :: DataCon -> TyCon
 170 dataConTyCon = dcTyCon
 171
 172 dataConType :: DataCon -> Type
 173 dataConType = dcType
 174
 175 dataConId :: DataCon -> Id
 176 dataConId = dcId
 177
 178
 179 dataConFieldLabels :: DataCon -> [FieldLabel]
 180 dataConFieldLabels = dcFields
 181
 182 dataConStrictMarks :: DataCon -> [StrictnessMark]
 183 dataConStrictMarks = dcStricts
 184
 185 dataConRawArgTys :: DataCon -> [TauType] -- a function of convenience
 186 dataConRawArgTys = dcArgTys
 187
 188 dataConSourceArity :: DataCon -> Arity
 189         -- Source-level arity of the data constructor
 190 dataConSourceArity dc = length (dcArgTys dc)
 191
 192 dataConSig :: DataCon -> ([TyVar], ThetaType,
 193                           [TyVar], ThetaType,
 194                           [TauType], TyCon)
 195
 196 dataConSig (MkData {dcTyVars = tyvars, dcTheta = theta,
 197                      dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
 198                      dcArgTys = arg_tys, dcTyCon = tycon})
 199   = (tyvars, theta, ex_tyvars, ex_theta, arg_tys, tycon)
 200
 201 dataConArgTys :: DataCon
 202               -> [Type]         -- Instantiated at these types
 203                                 -- NB: these INCLUDE the existentially quantified arg types
 204               -> [Type]         -- Needs arguments of these types
 205                                 -- NB: these INCLUDE the existentially quantified dict args
 206                                 --     but EXCLUDE the data-decl context which is discarded
 207
 208 dataConArgTys (MkData {dcArgTys = arg_tys, dcTyVars = tyvars,
 209                        dcExTyVars = ex_tyvars, dcExTheta = ex_theta}) inst_tys
 210  = map (substTy (zipVarEnv (tyvars ++ ex_tyvars) inst_tys))
 211        ([mkDictTy cls tys | (cls,tys) <- ex_theta] ++ arg_tys)
 212 \end{code}
 213
 214 dataConNumFields gives the number of actual fields in the
 215 {\em representation} of the data constructor.  This may be more than appear
 216 in the source code; the extra ones are the existentially quantified
 217 dictionaries
 218
 219 \begin{code}
 220 -- Number of type-instantiation arguments
 221 -- All the remaining arguments of the DataCon are (notionally)
 222 -- stored in the DataCon, and are matched in a case expression
 223 dataConNumInstArgs (MkData {dcTyVars = tyvars}) = length tyvars
 224
 225 dataConNumFields (MkData {dcExTheta = theta, dcArgTys = arg_tys})
 226   = length theta + length arg_tys
 227
 228 isNullaryDataCon con
 229   = dataConNumFields con == 0 -- function of convenience
 230
 231 isTupleCon :: DataCon -> Bool
 232 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
 233
 234 isUnboxedTupleCon :: DataCon -> Bool
 235 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
 236
 237 isExistentialDataCon :: DataCon -> Bool
 238 isExistentialDataCon (MkData {dcExTyVars = tvs}) = not (null tvs)
 239 \end{code}