[commit: ghc] type-holes-branch: Apply mkForAllTys to the hole's type again. (a61a3f9)

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

On branch  : type-holes-branch

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

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

commit a61a3f951d0c16236c4cc2e24dc6219429c13413
Author: Thijs Alkemade <[email protected]>
Date:   Thu Jan 5 22:08:43 2012 +0100

    Apply mkForAllTys to the hole's type again.
    
    Now the result is consistent with the final
    output. However, it contains a lot of
    incorrect quantification.

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

 compiler/main/InteractiveEval.hs  |    2 +-
 compiler/typecheck/TcRnDriver.lhs |    4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index eee5c00..612d8ea 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -931,7 +931,7 @@ parseName str = withSession $ \hsc_env -> do
 exprType :: GhcMonad m => String -> m Type
 exprType expr = withSession $ \hsc_env -> do
    ty <- liftIO $ hscTcExpr hsc_env expr
-   return $ tidyType emptyTidyEnv ty
+   return {-$ tidyType emptyTidyEnv-} ty
 
 -- -----------------------------------------------------------------------------
 -- Getting the kind of a type
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 28ecb62..7f4b390 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -1448,13 +1448,13 @@ tcRnExpr hsc_env ictxt rdr_expr
     
     (_, l) <- getEnvs ;
     holes <- readTcRef $ tcl_holes l ;
-    zonked_holes <- mapM (\(s, ty) -> liftM (\t -> (s, t)) $ zonkTcType ty)
+    zonked_holes <- mapM (\(s, ty) -> liftM (\t -> (s, mkForAllTys qtvs t)) $ zonkTcType ty)
     				$ Map.toList $ Map.map (\ty -> mkPiTypes dicts ty) $ holes ;
     let { (env, tys) = foldr tidy (emptyTidyEnv, []) zonked_holes } ;
     liftIO $ putStrLn ("tcRnExpr2: " ++ (showSDoc $ ppr $ tys)) ;
     liftIO $ putStrLn ("tcRnExpr3: " ++ (showSDoc $ ppr env)) ;
 
-    return result
+    return $ snd $ tidyOpenType env result
     }
     where tidy (s, ty) (env, tys) = let (env', ty') = tidyOpenType env ty in (env', (s, ty') : tys)