[commit: ghc] : Redefine tcSplitDFunTy so that it returns the types of the theta as well (c30fc1d)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : 

http://hackage.haskell.org/trac/ghc/changeset/c30fc1dce507d2e3a185edfb5f7aae71ab9c444c

>---------------------------------------------------------------

commit c30fc1dce507d2e3a185edfb5f7aae71ab9c444c
Author: Max Bolingbroke <[email protected]>
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