Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch :
http://hackage.haskell.org/trac/ghc/changeset/c30fc1dce507d2e3a185edfb5f7aae71ab9c444c >--------------------------------------------------------------- commit c30fc1dce507d2e3a185edfb5f7aae71ab9c444c Author: Max Bolingbroke <batterseapo...@hotmail.com> Date: Mon Feb 20 16:00:53 2012 +0000 Redefine tcSplitDFunTy so that it returns the types of the theta as well >--------------------------------------------------------------- compiler/coreSyn/CoreUnfold.lhs | 4 ++-- compiler/typecheck/TcType.lhs | 21 +++++++++++---------- 2 files changed, 13 insertions(+), 12 deletions(-) diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs index 5817669..7488040 100644 --- a/compiler/coreSyn/CoreUnfold.lhs +++ b/compiler/coreSyn/CoreUnfold.lhs @@ -100,8 +100,8 @@ mkDFunUnfolding :: Type -> [CoreExpr] -> Unfolding mkDFunUnfolding dfun_ty ops = DFunUnfolding dfun_nargs data_con ops where - (tvs, n_theta, cls, _) = tcSplitDFunTy dfun_ty - dfun_nargs = length tvs + n_theta + (tvs, theta, cls, _) = tcSplitDFunTy dfun_ty + dfun_nargs = length tvs + length theta data_con = classDataCon cls mkWwInlineRule :: Id -> CoreExpr -> Arity -> Unfolding diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index b45824f..62650ba 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -997,23 +997,24 @@ tcIsTyVarTy :: Type -> Bool tcIsTyVarTy ty = maybeToBool (tcGetTyVar_maybe ty) ----------------------- -tcSplitDFunTy :: Type -> ([TyVar], Int, Class, [Type]) +tcSplitDFunTy :: Type -> ([TyVar], [Type], Class, [Type]) -- Split the type of a dictionary function -- We don't use tcSplitSigmaTy, because a DFun may (with NDP) -- have non-Pred arguments, such as -- df :: forall m. (forall b. Eq b => Eq (m b)) -> C m tcSplitDFunTy ty - = case tcSplitForAllTys ty of { (tvs, rho) -> - case split_dfun_args 0 rho of { (n_theta, tau) -> - case tcSplitDFunHead tau of { (clas, tys) -> - (tvs, n_theta, clas, tys) }}} - where - -- Count the context of the dfun. This can be a mix of + = case tcSplitForAllTys ty of { (tvs, rho) -> + case tcSplitAnyFunTys rho of { (theta, tau) -> + case tcSplitDFunHead tau of { (clas, tys) -> + (tvs, theta, clas, tys) }}} + -- The context of the dfun can be a mix of -- coercion and class constraints; or (in the general NDP case) -- some other function argument - split_dfun_args n ty | Just ty' <- tcView ty = split_dfun_args n ty' - split_dfun_args n (FunTy _ ty) = split_dfun_args (n+1) ty - split_dfun_args n ty = (n, ty) + where + tcSplitAnyFunTys :: Type -> ([Type], Type) + tcSplitAnyFunTys ty | Just ty' <- tcView ty = tcSplitAnyFunTys ty' + tcSplitAnyFunTys (FunTy arg res) = case tcSplitAnyFunTys res of (args, ty') -> (arg:args, ty') + tcSplitAnyFunTys ty = ([], ty) tcSplitDFunHead :: Type -> (Class, [Type]) tcSplitDFunHead = getClassPredTys _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
