\begin{code}
module DataCon (
- DataCon,
+ DataCon, DataConIds(..),
ConTag, fIRST_TAG,
mkDataCon,
dataConRepType, dataConSig, dataConName, dataConTag, dataConTyCon,
dataConArgTys, dataConOrigArgTys, dataConInstOrigArgTys,
dataConRepArgTys, dataConTheta,
- dataConFieldLabels, dataConStrictMarks,
+ dataConFieldLabels, dataConStrictMarks, dataConExStricts,
dataConSourceArity, dataConRepArity,
- dataConNumInstArgs, dataConWorkId, dataConWrapId, dataConRepStrictness,
+ dataConNumInstArgs, dataConIsInfix,
+ dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds,
+ dataConRepStrictness,
isNullaryDataCon, isTupleCon, isUnboxedTupleCon,
isExistentialDataCon, classDataCon, dataConExistentialTyVars,
#include "HsVersions.h"
import {-# SOURCE #-} Subst( substTyWith )
-import {-# SOURCE #-} PprType( pprType )
import Type ( Type, ThetaType,
mkForAllTys, mkFunTys, mkTyConApp,
- mkTyVarTys, splitTyConApp_maybe, repType,
- mkPredTys, isStrictType
+ mkTyVarTys, splitTyConApp_maybe,
+ mkPredTys, isStrictPred, pprType
)
import TyCon ( TyCon, tyConDataCons, tyConDataCons, isProductTyCon,
- isTupleTyCon, isUnboxedTupleTyCon, isRecursiveTyCon )
+ isTupleTyCon, isUnboxedTupleTyCon )
import Class ( Class, classTyCon )
import Name ( Name, NamedThing(..), nameUnique )
import Var ( TyVar, Id )
import BasicTypes ( Arity, StrictnessMark(..) )
import Outputable
import Unique ( Unique, Uniquable(..) )
-import CmdLineOpts ( opt_UnboxStrictFields )
-import Maybe
import ListSetOps ( assoc )
-import Util ( zipEqual, zipWithEqual, equalLength )
+import Util ( zipEqual, zipWithEqual, notNull )
\end{code}
-Stuff about data constructors
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Every constructor, C, comes with a
+Data constructor representation
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider the following Haskell data type declaration
- *wrapper*, called C, whose type is exactly what it looks like
- in the source program. It is an ordinary function,
- and it gets a top-level binding like any other function
+ data T = T !Int ![Int]
+
+Using the strictness annotations, GHC will represent this as
+
+ data T = T Int# [Int]
+
+That is, the Int has been unboxed. Furthermore, the Haskell source construction
+
+ T e1 e2
+
+is translated to
+
+ case e1 of { I# x ->
+ case e2 of { r ->
+ T x r }}
+
+That is, the first argument is unboxed, and the second is evaluated. Finally,
+pattern matching is translated too:
+
+ case e of { T a b -> ... }
+
+becomes
+
+ case e of { T a' b -> let a = I# a' in ... }
- *worker*, called $wC, which is the actual data constructor.
- Its type may be different to C, because:
+To keep ourselves sane, we name the different versions of the data constructor
+differently, as follows.
+
+
+Note [Data Constructor Naming]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Each data constructor C has two, and possibly three, Names associated with it:
+
+ OccName Name space Used for
+ ---------------------------------------------------------------------------
+ * The "source data con" C DataName The DataCon itself
+ * The "real data con" C VarName Its worker Id
+ * The "wrapper data con" $WC VarName Wrapper Id (optional)
+
+Each of these three has a distinct Unique. The "source data con" name
+appears in the output of the renamer, and names the Haskell-source
+data constructor. The type checker translates it into either the wrapper Id
+(if it exists) or worker Id (otherwise).
+
+The data con has one or two Ids associated with it:
+
+ The "worker Id", is the actual data constructor.
+ Its type may be different to the Haskell source constructor
+ because:
- useless dict args are dropped
- strict args may be flattened
- It does not have a binding.
+ The worker is very like a primop, in that it has no binding.
+
+ Newtypes currently do get a worker-Id, but it is never used.
+
+
+ The "wrapper Id", $wC, whose type is exactly what it looks like
+ in the source program. It is an ordinary function,
+ and it gets a top-level binding like any other function.
+
+ The wrapper Id isn't generated for a data type if the worker
+ and wrapper are identical. It's always generated for a newtype.
- The worker is very like a primop, in that it has no binding,
A note about the stupid context
separately in the type checker on occurrences of a constructor, either
in an expression or in a pattern.
+[May 2003: actually I think this decision could evasily be reversed now,
+and probably should be. Generics could be disabled for types with
+a stupid context; record updates now (H98) needs the context too; etc.
+It's an unforced change, so I'm leaving it for now --- but it does seem
+odd that the wrapper doesn't include the stupid context.]
+
%************************************************************************
data DataCon
= MkData { -- Used for data constructors only;
-- there *is* no constructor for a newtype
- dcName :: Name,
+
+ dcName :: Name, -- This is the name of the *source data con*
+ -- (see "Note [Data Constructor Naming]" above)
+
dcUnique :: Unique, -- Cached from Name
dcTag :: ConTag,
-- "Stupid", because the dictionaries aren't used for anything.
--
-- Indeed, [as of March 02] they are no
- -- longer in the type of the dataConWrapId, because
+ -- longer in the type of the wrapper Id, because
-- that makes it harder to use the wrap-id to rebuild
-- values after record selection or in generics.
-- (before unboxing and flattening of
-- strict fields)
- dcRepArgTys :: [Type], -- Final, representation argument types, after unboxing and flattening,
- -- and including existential dictionaries
-
- dcRepStrictness :: [StrictnessMark], -- One for each representation argument
-
- dcTyCon :: TyCon, -- Result tycon
-
-- Now the strictness annotations and field labels of the constructor
dcStrictMarks :: [StrictnessMark],
- -- Strictness annotations as deduced by the compiler.
- -- Has no MarkedUserStrict; they have been changed to MarkedStrict
- -- or MarkedUnboxed by the compiler.
- -- *Includes the existential dictionaries*
- -- length = length dcExTheta + dataConSourceArity dataCon
+ -- Strictness annotations as decided by the compiler.
+ -- Does *not* include the existential dictionaries
+ -- length = dataConSourceArity dataCon
dcFields :: [FieldLabel],
-- Field labels for this constructor, in the
-- same order as the argument types;
-- length = 0 (if not a record) or dataConSourceArity.
+ -- Constructor representation
+ dcRepArgTys :: [Type], -- Final, representation argument types,
+ -- after unboxing and flattening,
+ -- and *including* existential dictionaries
+
+ dcRepStrictness :: [StrictnessMark], -- One for each representation argument
+
+ dcTyCon :: TyCon, -- Result tycon
+
-- Finally, the curried worker function that corresponds to the constructor
-- It doesn't have an unfolding; the code generator saturates these Ids
-- and allocates a real constructor when it finds one.
--
-- An entirely separate wrapper function is built in TcTyDecls
- dcWorkId :: Id, -- The corresponding worker Id
- -- Takes dcRepArgTys as its arguments
+ dcIds :: DataConIds,
- dcWrapId :: Id -- The wrapper Id
+ dcInfix :: Bool -- True <=> declared infix
+ -- Used for Template Haskell and 'deriving' only
+ -- The actual fixity is stored elsewhere
}
+data DataConIds
+ = NewDC Id -- Newtypes have only a wrapper, but no worker
+ | AlgDC (Maybe Id) Id -- Algebraic data types always have a worker, and
+ -- may or may not have a wrapper, depending on whether
+ -- the wrapper does anything.
+
+ -- *Neither* the worker *nor* the wrapper take the dcStupidTheta dicts as arguments
+
+ -- The wrapper takes dcOrigArgTys as its arguments
+ -- The worker takes dcRepArgTys as its arguments
+ -- If the worker is absent, dcRepArgTys is the same as dcOrigArgTys
+
+ -- The 'Nothing' case of AlgDC is important
+ -- Not only is this efficient,
+ -- but it also ensures that the wrapper is replaced
+ -- by the worker (becuase it *is* the wroker)
+ -- even when there are no args. E.g. in
+ -- f (:) x
+ -- the (:) *is* the worker.
+ -- This is really important in rule matching,
+ -- (We could match on the wrappers,
+ -- but that makes it less likely that rules will match
+ -- when we bring bits of unfoldings together.)
+
type ConTag = Int
fIRST_TAG :: ConTag
%************************************************************************
\begin{code}
-mkDataCon :: Name
+mkDataCon :: Name
+ -> Bool -- Declared infix
-> [StrictnessMark] -> [FieldLabel]
-> [TyVar] -> ThetaType
-> [TyVar] -> ThetaType
-> [Type] -> TyCon
- -> Id -> Id
+ -> DataConIds
-> DataCon
-- Can get the tag from the TyCon
-mkDataCon name arg_stricts fields
+mkDataCon name declared_infix
+ arg_stricts -- Must match orig_arg_tys 1-1
+ fields
tyvars theta ex_tyvars ex_theta orig_arg_tys tycon
- work_id wrap_id
- = ASSERT(equalLength arg_stricts orig_arg_tys)
- -- The 'stricts' passed to mkDataCon are simply those for the
- -- source-language arguments. We add extra ones for the
- -- dictionary arguments right here.
- con
+ ids
+ = con
where
- con = MkData {dcName = name, dcUnique = nameUnique name,
+ con = MkData {dcName = name,
+ dcUnique = nameUnique name,
dcTyVars = tyvars, dcStupidTheta = theta,
dcOrigArgTys = orig_arg_tys,
dcRepArgTys = rep_arg_tys,
dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
- dcStrictMarks = real_stricts, dcRepStrictness = rep_arg_stricts,
+ dcStrictMarks = arg_stricts, dcRepStrictness = rep_arg_stricts,
dcFields = fields, dcTag = tag, dcTyCon = tycon, dcRepType = ty,
- dcWorkId = work_id, dcWrapId = wrap_id}
+ dcIds = ids, dcInfix = declared_infix}
-- Strictness marks for source-args
-- *after unboxing choices*,
-- but *including existential dictionaries*
+ --
+ -- The 'arg_stricts' passed to mkDataCon are simply those for the
+ -- source-language arguments. We add extra ones for the
+ -- dictionary arguments right here.
ex_dict_tys = mkPredTys ex_theta
- real_stricts = (map mk_dict_strict_mark ex_dict_tys) ++
- zipWithEqual "mkDataCon1" (chooseBoxingStrategy tycon)
- orig_arg_tys arg_stricts
- real_arg_tys = ex_dict_tys ++ orig_arg_tys
+ real_arg_tys = ex_dict_tys ++ orig_arg_tys
+ real_stricts = map mk_dict_strict_mark ex_theta ++ arg_stricts
-- Representation arguments and demands
(rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
-mk_dict_strict_mark ty | isStrictType ty = MarkedStrict
- | otherwise = NotMarkedStrict
+mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
+ | otherwise = NotMarkedStrict
\end{code}
\begin{code}
dataConRepType :: DataCon -> Type
dataConRepType = dcRepType
+dataConIsInfix :: DataCon -> Bool
+dataConIsInfix = dcInfix
+
dataConWorkId :: DataCon -> Id
-dataConWorkId = dcWorkId
+dataConWorkId dc = case dcIds dc of
+ AlgDC _ wrk_id -> wrk_id
+ NewDC _ -> pprPanic "dataConWorkId" (ppr dc)
+
+dataConWrapId_maybe :: DataCon -> Maybe Id
+dataConWrapId_maybe dc = case dcIds dc of
+ AlgDC mb_wrap _ -> mb_wrap
+ NewDC wrap -> Just wrap
dataConWrapId :: DataCon -> Id
-dataConWrapId = dcWrapId
+-- Returns an Id which looks like the Haskell-source constructor
+dataConWrapId dc = case dcIds dc of
+ AlgDC (Just wrap) _ -> wrap
+ AlgDC Nothing wrk -> wrk -- worker=wrapper
+ NewDC wrap -> wrap
+
+dataConImplicitIds :: DataCon -> [Id]
+dataConImplicitIds dc = case dcIds dc of
+ AlgDC (Just wrap) work -> [wrap,work]
+ AlgDC Nothing work -> [work]
+ NewDC wrap -> [wrap]
dataConFieldLabels :: DataCon -> [FieldLabel]
dataConFieldLabels = dcFields
dataConStrictMarks :: DataCon -> [StrictnessMark]
dataConStrictMarks = dcStrictMarks
+dataConExStricts :: DataCon -> [StrictnessMark]
+-- Strictness of *existential* arguments only
+-- Usually empty, so we don't bother to cache this
+dataConExStricts dc = map mk_dict_strict_mark (dcExTheta dc)
+
-- Number of type-instantiation arguments
-- All the remaining arguments of the DataCon are (notionally)
-- stored in the DataCon, and are matched in a case expression
isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
isExistentialDataCon :: DataCon -> Bool
-isExistentialDataCon (MkData {dcExTyVars = tvs}) = not (null tvs)
+isExistentialDataCon (MkData {dcExTyVars = tvs}) = notNull tvs
\end{code}
Just stuff -> stuff
Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
--- We attempt to unbox/unpack a strict field when either:
--- (i) The tycon is imported, and the field is marked '! !', or
--- (ii) The tycon is defined in this module, the field is marked '!',
--- and the -funbox-strict-fields flag is on.
---
--- This ensures that if we compile some modules with -funbox-strict-fields and
--- some without, the compiler doesn't get confused about the constructor
--- representations.
-
-chooseBoxingStrategy :: TyCon -> Type -> StrictnessMark -> StrictnessMark
- -- Transforms any MarkedUserStricts into MarkUnboxed or MarkedStrict
-chooseBoxingStrategy tycon arg_ty strict
- = case strict of
- MarkedUserStrict
- | opt_UnboxStrictFields
- && unbox arg_ty -> MarkedUnboxed
- | otherwise -> MarkedStrict
- other -> strict
- where
- -- beware: repType will go into a loop if we try this on a recursive
- -- type (for reasons unknown...), hence the check for recursion below.
- unbox ty =
- case splitTyConApp_maybe ty of
- Nothing -> False
- Just (arg_tycon, _)
- | isRecursiveTyCon arg_tycon -> False
- | otherwise ->
- case splitTyConApp_maybe (repType ty) of
- Nothing -> False
- Just (arg_tycon, _) -> isProductTyCon arg_tycon
computeRep :: [StrictnessMark] -- Original arg strictness
- -- [after strategy choice; can't be MarkedUserStrict]
-> [Type] -- and types
-> ([StrictnessMark], -- Representation arg strictness
[Type]) -- And type
unbox MarkedStrict ty = [(MarkedStrict, ty)]
unbox MarkedUnboxed ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
where
- (_, _, arg_dc, arg_tys) = splitProductType "unbox_strict_arg_ty" (repType ty)
+ (_, _, arg_dc, arg_tys) = splitProductType "unbox_strict_arg_ty" ty
\end{code}