[commit: ghc] wip/type-app: More error improving (44b5d1d)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/type-app
Link       : http://ghc.haskell.org/trac/ghc/changeset/44b5d1d76084643038d39f1d25ca162a572e95c2/ghc

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

commit 44b5d1d76084643038d39f1d25ca162a572e95c2
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Tue Aug 4 22:23:30 2015 -0400

    More error improving


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

44b5d1d76084643038d39f1d25ca162a572e95c2
 compiler/typecheck/TcExpr.hs                       | 6 ++++--
 testsuite/tests/typecheck/should_fail/T7851.stderr | 6 +++++-
 2 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 3d07539..c9776b9 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -1655,8 +1655,10 @@ addFunResCtxt has_args fun fun_res_ty env_ty
     mk_msg
       = do { fun_res' <- zonkTcType fun_res_ty
            ; env'     <- zonkTcType env_ty
-           ; let (args_fun, res_fun) = tcSplitFunTys fun_res'
-                 (args_env, res_env) = tcSplitFunTys env'
+           ; let (_, _, fun_tau) = tcSplitSigmaTy fun_res'
+                 (_, _, env_tau) = tcSplitSigmaTy env'
+                 (args_fun, res_fun) = tcSplitFunTys fun_tau
+                 (args_env, res_env) = tcSplitFunTys env_tau
                  n_fun = length args_fun
                  n_env = length args_env
                  info  | n_fun == n_env = Outputable.empty
diff --git a/testsuite/tests/typecheck/should_fail/T7851.stderr b/testsuite/tests/typecheck/should_fail/T7851.stderr
index 6414851..8dee324 100644
--- a/testsuite/tests/typecheck/should_fail/T7851.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7851.stderr
@@ -1,8 +1,12 @@
 
-T7851.hs:5:10:
+T7851.hs:5:10: error:
     Couldn't match expected type ‘IO a0’ with actual type ‘a1 -> IO ()’
     Probable cause: ‘print’ is applied to too few arguments
     In a stmt of a 'do' block: print
     In the expression:
       do { print;
            print "Hello" }
+    In an equation for ‘bar’:
+        bar
+          = do { print;
+                 print "Hello" }