[commit: ghc] type-holes-branch: Tidying is now properly done as a fold. (c96453a)

Simon Peyton Jones simonpj at microsoft.com
Mon Sep 17 13:02:37 CEST 2012


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

On branch  : type-holes-branch

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

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

commit c96453a8ab6e8845260689785d88f22b506f7c90
Author: Thijs Alkemade <thijsalkemade at gmail.com>
Date:   Thu Jan 5 16:17:11 2012 +0100

    Tidying is now properly done as a fold.
    
    The updated TidyEnv is passed to the next call. This does not make
    the types of the holes consistent with the final type (as they use
    a different order), but at least the types of the holes is in
    itself consistent.

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

 compiler/typecheck/TcRnDriver.lhs |   10 +++++++---
 1 files changed, 7 insertions(+), 3 deletions(-)

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index bed2703..6ec10ac 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -110,6 +110,7 @@ import Control.Monad
 import System.IO
 import TypeRep
 import qualified Data.Map as Map
+import TcType
 
 #include "HsVersions.h"
 \end{code}
@@ -225,7 +226,7 @@ tcRnModule hsc_env hsc_src save_rn_syntax
 
 	(_, l) <- getEnvs ;
     holes <- readTcRef $ tcl_holes l ;
-    zonked_holes <- mapM (\(s, ty) -> liftM (\t -> (s, tidyType emptyTidyEnv t)) $ zonkTcType ty)
+    zonked_holes <- mapM (\(s, ty) -> liftM (\t -> (s, {-tidyType emptyTidyEnv-} t)) $ zonkTcType ty)
     				$ Map.toList holes ;
     liftIO $ putStrLn ("tcRnModule: " ++ (showSDoc $ ppr $ zonked_holes)) ;
 
@@ -1439,14 +1440,17 @@ tcRnExpr hsc_env ictxt rdr_expr
 
     let { all_expr_ty = mkForAllTys qtvs (mkPiTypes dicts res_ty) } ;
     result <- zonkTcType all_expr_ty ;
+    
     (_, l) <- getEnvs ;
     holes <- readTcRef $ tcl_holes l ;
-    zonked_holes <- mapM (\(s, ty) -> liftM (\t -> (s, tidyType emptyTidyEnv t)) $ zonkTcType ty)
+    zonked_holes <- mapM (\(s, ty) -> liftM (\t -> (s, t)) $ zonkTcType ty)
     				$ Map.toList $ Map.map (\ty -> mkPiTypes dicts ty) $ holes ;
-    liftIO $ putStrLn ("tcRnExpr2: " ++ (showSDoc $ ppr $ zonked_holes)) ;
+    let { (env, tys) = foldr tidy (emptyTidyEnv, []) zonked_holes } ;
+    liftIO $ putStrLn ("tcRnExpr2: " ++ (showSDoc $ ppr $ tys)) ;
 
     return result
     }
+    where tidy (s, ty) (env, tys) = let (env', ty') = tidyOpenType env ty in (env', (s, ty') : tys)
 
 --------------------------
 tcRnImportDecls :: HscEnv





More information about the Cvs-ghc mailing list