[commit: ghc] type-holes-branch: Store TyVars instead of Types. Tidy types before printing. (63d7ee2)

[Simon Peyton Jones]

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

On branch  : type-holes-branch

http://hackage.haskell.org/trac/ghc/changeset/63d7ee2342a4e376c4a4e1eb699297c15b790d92

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

commit 63d7ee2342a4e376c4a4e1eb699297c15b790d92
Author: Thijs Alkemade <thijsalkemade at gmail.com>
Date:   Wed Dec 21 17:38:59 2011 +0100

    Store TyVars instead of Types. Tidy types before printing.
    
    TyVars are Names, so store their src position, however, it
    seems to not be used here.

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

 compiler/typecheck/TcExpr.lhs     |    8 ++++----
 compiler/typecheck/TcRnDriver.lhs |    8 +++++---
 compiler/typecheck/TcRnTypes.lhs  |    2 +-
 3 files changed, 10 insertions(+), 8 deletions(-)

diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index d337c33..def1d57 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -222,13 +222,13 @@ tcExpr (HsType ty) _
 	-- same parser parses *patterns*.
 tcExpr HsHole res_ty
   = do { liftIO $ putStrLn ("tcExpr.HsHole: " ++ (showSDoc $ ppr $ res_ty)) ;
-         (g, l) <- getEnvs ;
-         holes <- readTcRef $ tcl_holes l ;
-         writeTcRef (tcl_holes l) (res_ty : holes) ;
          printTy res_ty ;
          return HsHole }
        where printTy (TyVarTy ty) = let (MetaTv _ io) = tcTyVarDetails ty in 
-                                        do meta <- readTcRef io
+                                        do (g, l) <- getEnvs ;
+                                           holes <- readTcRef $ tcl_holes l ;
+                                           writeTcRef (tcl_holes l) (ty : holes) ;
+                                           meta <- readTcRef io
                                            liftIO $ putStrLn ("tcExpr.HsHole: " ++ (showSDoc $ ppr $ meta))
              printTy (ForAllTy _ _) = liftIO $ putStrLn ("tcExpr.HsHole: ForAllTy")
              printTy (PredTy _) = liftIO $ putStrLn ("tcExpr.HsHole: ForAllTy")
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 86e3963..2003ff6 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -47,7 +47,7 @@ import FamInstEnv
 import TcAnnotations
 import TcBinds
 import HeaderInfo       ( mkPrelImports )
-import TcType	( tidyTopType )
+import TcType	( tidyTopType, tidyType )
 import TcDefaults
 import TcEnv
 import TcRules
@@ -108,6 +108,7 @@ import Bag
 import Control.Monad
 
 import System.IO
+import TypeRep
 
 #include "HsVersions.h"
 \end{code}
@@ -1429,8 +1430,9 @@ tcRnExpr hsc_env ictxt rdr_expr
 
     (g, l) <- getEnvs ;
     holes <- readTcRef $ tcl_holes l ;
-    zonked_holes <- mapM (\ty -> zonkTcType $ mkForAllTys qtvs (mkPiTypes dicts ty)) $ holes ;
-    liftIO $ putStrLn ("tcRnExpr2: " ++ (showSDoc $ ppr $ zonked_holes)) ;
+    zonked_holes <- zonkTcTypes $ map (\ty -> mkForAllTys qtvs (mkPiTypes dicts (TyVarTy ty))) $ holes ;
+    liftIO $ putStrLn ("tcRnExpr2: " ++ (showSDoc $ ppr $ zip holes (map (tidyType emptyTidyEnv) zonked_holes))) ;
+    liftIO $ putStrLn ("tcRnExpr3: " ++ (showSDoc $ ppr $ dicts)) ;
     let { all_expr_ty = mkForAllTys qtvs (mkPiTypes dicts res_ty) } ;
     zonkTcType all_expr_ty
     }
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 2ef124e..21536bb 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -440,7 +440,7 @@ data TcLclEnv		-- Changes as we move inside an expression
 	tcl_untch :: Unique,	    -- Any TcMetaTyVar with 
 		     		    --     unique >= tcl_untch is touchable
 		     		    --     unique <  tcl_untch is untouchable
-	tcl_holes :: TcRef [Type]
+	tcl_holes :: TcRef [TyVar]
     }
 
 type TcTypeEnv = NameEnv TcTyThing