dataConSourceArity, dataConRepArity,
dataConNumInstArgs, dataConId, dataConWrapId, dataConRepStrictness,
isNullaryDataCon, isTupleCon, isUnboxedTupleCon,
- isExistentialDataCon,
+ isExistentialDataCon, classDataCon,
splitProductType_maybe, splitProductType,
import {-# SOURCE #-} Subst( substTy, mkTyVarSubst )
import CmdLineOpts ( opt_DictsStrict )
-import Type ( Type, ThetaType, TauType, ClassContext,
+import Type ( Type, TauType, ThetaType,
mkForAllTys, mkFunTys, mkTyConApp,
- mkTyVarTys, mkDictTys,
- splitTyConApp_maybe, classesToPreds
+ mkTyVarTys, mkPredTys, getClassPredTys_maybe,
+ splitTyConApp_maybe
)
import TyCon ( TyCon, tyConDataCons, tyConDataConsIfAvailable, isDataTyCon, isProductTyCon,
isTupleTyCon, isUnboxedTupleTyCon, isRecursiveTyCon )
-import Class ( classTyCon )
-import Name ( Name, NamedThing(..), nameUnique, isLocallyDefined )
+import Class ( Class, classTyCon )
+import Name ( Name, NamedThing(..), nameUnique )
import Var ( TyVar, Id )
import FieldLabel ( FieldLabel )
import BasicTypes ( Arity )
-- These are ALWAYS THE SAME AS THE TYVARS
-- FOR THE PARENT TyCon. We occasionally rely on
-- this just to avoid redundant instantiation
- dcTheta :: ClassContext,
+ dcTheta :: ThetaType,
dcExTyVars :: [TyVar], -- Ditto for the context of the constructor,
- dcExTheta :: ClassContext, -- the existentially quantified stuff
+ dcExTheta :: ThetaType, -- the existentially quantified stuff
dcOrigArgTys :: [Type], -- Original argument types
-- (before unboxing and flattening of
\begin{code}
mkDataCon :: Name
-> [StrictnessMark] -> [FieldLabel]
- -> [TyVar] -> ClassContext
- -> [TyVar] -> ClassContext
+ -> [TyVar] -> ThetaType
+ -> [TyVar] -> ThetaType
-> [TauType] -> TyCon
-> Id -> Id
-> DataCon
(real_arg_stricts, strict_arg_tyss)
= unzip (zipWith (unbox_strict_arg_ty tycon) arg_stricts orig_arg_tys)
- rep_arg_tys = mkDictTys ex_theta ++ concat strict_arg_tyss
+ rep_arg_tys = mkPredTys ex_theta ++ concat strict_arg_tyss
ex_dict_stricts = map mk_dict_strict_mark ex_theta
-- Add a strictness flag for the existential dictionary arguments
result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
-mk_dict_strict_mark (clas,tys)
- | opt_DictsStrict &&
- -- Don't mark newtype things as strict!
+mk_dict_strict_mark pred
+ | opt_DictsStrict, -- Don't mark newtype things as strict!
+ Just (clas,_) <- getClassPredTys_maybe pred,
isDataTyCon (classTyCon clas) = MarkedStrict
| otherwise = NotMarkedStrict
\end{code}
go (NotMarkedStrict : ss) = wwLazy : go ss
go (MarkedUnboxed con _ : ss) = go (dcRealStricts con ++ ss)
-dataConSig :: DataCon -> ([TyVar], ClassContext,
- [TyVar], ClassContext,
+dataConSig :: DataCon -> ([TyVar], ThetaType,
+ [TyVar], ThetaType,
[TauType], TyCon)
dataConSig (MkData {dcTyVars = tyvars, dcTheta = theta,
dcExTyVars = ex_tyvars}) inst_tys
= map (substTy (mkTyVarSubst (tyvars ++ ex_tyvars) inst_tys)) arg_tys
-dataConTheta :: DataCon -> ClassContext
+dataConTheta :: DataCon -> ThetaType
dataConTheta dc = dcTheta dc
-- And the same deal for the original arg tys:
\end{code}
+\begin{code}
+classDataCon :: Class -> DataCon
+classDataCon clas = case tyConDataCons (classTyCon clas) of
+ (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
+\end{code}
+
%************************************************************************
%* *
\subsection{Splitting products}
unbox_strict_arg_ty tycon strict_mark ty
| case strict_mark of
NotMarkedStrict -> False
- MarkedUnboxed _ _ -> True
- MarkedStrict -> opt_UnboxStrictFields &&
- isLocallyDefined tycon &&
+ MarkedUnboxed _ _ -> True -- !! From interface file
+ MarkedStrict -> opt_UnboxStrictFields && -- ! From source
maybeToBool maybe_product &&
not (isRecursiveTyCon tycon) &&
isDataTyCon arg_tycon