From 6921b9f3849183c6df7b1417d696783ad1c26bbe Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Wed, 20 Sep 2006 18:20:48 +0000 Subject: [PATCH] Include the existential dictionaries in dataConOrigInstPat Mon Sep 18 17:22:14 EDT 2006 Manuel M T Chakravarty * Include the existential dictionaries in dataConOrigInstPat Sun Aug 6 20:59:00 EDT 2006 Manuel M T Chakravarty * Include the existential dictionaries in dataConOrigInstPat Fri Aug 4 04:24:25 EDT 2006 simonpj@microsoft.com --- compiler/coreSyn/CoreUtils.lhs | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs index 7344efd..c431b2d 100644 --- a/compiler/coreSyn/CoreUtils.lhs +++ b/compiler/coreSyn/CoreUtils.lhs @@ -44,9 +44,8 @@ import GLAEXTS -- For `xori` import CoreSyn import CoreFVs ( exprFreeVars ) import PprCore ( pprCoreExpr ) -import Var ( Var, TyVar, CoVar, isCoVar, tyVarKind, setVarUnique, - mkCoVar, mkTyVar, mkCoVar ) -import OccName ( OccName, occNameFS, mkVarOccFS ) +import Var ( Var, TyVar, CoVar, isCoVar, tyVarKind, mkCoVar, mkTyVar ) +import OccName ( mkVarOccFS ) import VarSet ( unionVarSet ) import VarEnv import Name ( hashName, mkSysTvName ) @@ -56,9 +55,9 @@ import Packages ( isDllName ) import Literal ( hashLiteral, literalType, litIsDupable, litIsTrivial, isZeroLit, Literal( MachLabel ) ) import DataCon ( DataCon, dataConRepArity, eqSpecPreds, - isVanillaDataCon, dataConTyCon, dataConRepArgTys, + dataConTyCon, dataConRepArgTys, dataConUnivTyVars, dataConExTyVars, dataConEqSpec, - dataConOrigArgTys ) + dataConOrigArgTys, dataConTheta ) import PrimOp ( PrimOp(..), primOpOkForSpeculation, primOpIsCheap ) import Id ( Id, idType, globalIdDetails, idNewStrictness, mkWildId, idArity, idName, idUnfolding, idInfo, @@ -70,14 +69,14 @@ import NewDemand ( appIsBottom ) import Type ( Type, mkFunTy, mkForAllTy, splitFunTy_maybe, splitFunTy, tcEqTypeX, applyTys, isUnLiftedType, seqType, mkTyVarTy, - splitForAllTy_maybe, isForAllTy, splitRecNewType_maybe, + splitForAllTy_maybe, isForAllTy, splitTyConApp_maybe, coreEqType, funResultTy, applyTy, substTyWith, mkPredTy ) import Coercion ( Coercion, mkTransCoercion, coercionKind, - splitNewTypeRepCo_maybe, mkSymCoercion, mkLeftCoercion, - mkRightCoercion, decomposeCo, coercionKindPredTy, - splitCoercionKind, mkEqPred ) + splitNewTypeRepCo_maybe, mkSymCoercion, + decomposeCo, coercionKindPredTy, + splitCoercionKind ) import TyCon ( tyConArity ) import TysWiredIn ( boolTy, trueDataCon, falseDataCon ) import CostCentre ( CostCentre ) @@ -211,8 +210,8 @@ mkInlineMe e = Note InlineMe e \begin{code} mkCoerce :: Coercion -> CoreExpr -> CoreExpr mkCoerce co (Cast expr co2) - = ASSERT(let { (from_ty, to_ty) = coercionKind co; - (from_ty2, to_ty2) = coercionKind co2} in + = ASSERT(let { (from_ty, _to_ty) = coercionKind co; + (_from_ty2, to_ty2) = coercionKind co2} in from_ty `coreEqType` to_ty2 ) mkCoerce (mkTransCoercion co2 co) expr @@ -681,9 +680,12 @@ deepCast ty tyVars co coArgs = decomposeCo (length tyVars) co -- These InstPat functions go here to avoid circularity between DataCon and Id -dataConOrigInstPat = dataConInstPat dataConOrigArgTys (repeat (FSLIT("ipv"))) dataConRepInstPat = dataConInstPat dataConRepArgTys (repeat (FSLIT("ipv"))) dataConRepFSInstPat = dataConInstPat dataConRepArgTys +dataConOrigInstPat = dataConInstPat dc_arg_tys (repeat (FSLIT("ipv"))) + where + dc_arg_tys dc = map mkPredTy (dataConTheta dc) ++ dataConOrigArgTys dc + -- Remember to include the existential dictionaries dataConInstPat :: (DataCon -> [Type]) -- function used to find arg tys -> [FastString] -- A long enough list of FSs to use for names @@ -730,7 +732,6 @@ dataConInstPat arg_fun fss uniqs con inst_tys n_ex = length ex_tvs n_co = length eq_spec - n_id = length arg_tys -- split the Uniques and FastStrings (ex_uniqs, uniqs') = splitAt n_ex uniqs @@ -799,7 +800,7 @@ exprIsConApp_maybe (Cast expr co) arity = tyConArity tc n_ex_tvs = length dc_ex_tyvars - (univ_args, rest) = splitAt arity args + (_univ_args, rest) = splitAt arity args (ex_args, val_args) = splitAt n_ex_tvs rest arg_tys = dataConRepArgTys dc @@ -809,7 +810,6 @@ exprIsConApp_maybe (Cast expr co) deep arg_ty = deepCast arg_ty dc_tyvars co -- first we appropriately cast the value arguments - arg_cos = map deep arg_tys new_val_args = zipWith mkCoerce (map deep arg_tys) val_args -- then we cast the existential coercion arguments -- 1.7.10.4