#include "HsVersions.h"
import {-# SOURCE #-} Subst( substTyWith )
+import {-# SOURCE #-} PprType( pprType )
import CmdLineOpts ( opt_DictsStrict )
import Type ( Type, TauType, ThetaType,
mkForAllTys, mkFunTys, mkTyConApp,
- mkTyVarTys, splitTyConApp_maybe, repType
+ mkTyVarTys, splitTyConApp_maybe, repType,
+ mkPredTys, isStrictType
)
-import TcType ( isStrictPred, mkPredTys )
import TyCon ( TyCon, tyConDataCons, tyConDataConsIfAvailable, isProductTyCon,
isTupleTyCon, isUnboxedTupleTyCon, isRecursiveTyCon )
import Class ( Class, classTyCon )
import Name ( Name, NamedThing(..), nameUnique )
import Var ( TyVar, Id )
import FieldLabel ( FieldLabel )
-import BasicTypes ( Arity )
-import Demand ( Demand, StrictnessMark(..), wwStrict, wwLazy )
+import BasicTypes ( Arity, StrictnessMark(..) )
+import NewDemand ( Demand, lazyDmd, seqDmd )
import Outputable
import Unique ( Unique, Uniquable(..) )
import CmdLineOpts ( opt_UnboxStrictFields )
-import PprType () -- Instances
import Maybe
import ListSetOps ( assoc )
import Util ( zipEqual, zipWithEqual )
-- Strictness marks for source-args
-- *after unboxing choices*,
-- but *including existential dictionaries*
- real_stricts = (map mk_dict_strict_mark ex_theta) ++
+ 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
= unzip $ concat $
zipWithEqual "mkDataCon2" unbox_strict_arg_ty
real_stricts
- (mkPredTys ex_theta ++ orig_arg_tys)
+ (ex_dict_tys ++ orig_arg_tys)
tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
ty = mkForAllTys (tyvars ++ ex_tyvars)
result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
-mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
- | otherwise = NotMarkedStrict
+mk_dict_strict_mark ty | isStrictType ty = MarkedStrict
+ | otherwise = NotMarkedStrict
\end{code}
\begin{code}
splitProductType str ty
= case splitProductType_maybe ty of
Just stuff -> stuff
- Nothing -> pprPanic (str ++ ": not a product") (ppr ty)
+ 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
Just (arg_tycon, _) -> isProductTyCon arg_tycon
unbox_strict_arg_ty
- :: StrictnessMark -- After strategy choice; can't be MkaredUserStrict
+ :: StrictnessMark -- After strategy choice; can't be MarkedUserStrict
-> Type -- Source argument type
-> [(Demand,Type)] -- Representation argument types and demamds
-unbox_strict_arg_ty NotMarkedStrict ty = [(wwLazy, ty)]
-unbox_strict_arg_ty MarkedStrict ty = [(wwStrict, ty)]
+unbox_strict_arg_ty NotMarkedStrict ty = [(lazyDmd, ty)]
+unbox_strict_arg_ty MarkedStrict ty = [(seqDmd, ty)]
unbox_strict_arg_ty MarkedUnboxed ty
= zipEqual "unbox_strict_arg_ty" (dataConRepStrictness arg_data_con) arg_tys
where
- (_, _, arg_data_con, arg_tys)
- = splitProductType "unbox_strict_arg_ty" (repType ty)
+ (_, _, arg_data_con, arg_tys) = splitProductType "unbox_strict_arg_ty" (repType ty)
\end{code}