[commit: ghc] type-holes-branch: Storing the TyVar was wrong, it has to store the type. (d22ae0e)
Simon Peyton Jones <[email protected]>
| Newsgroups | gmane.comp.lang.haskell.cvs.ghc |
|---|---|
| Message-ID | <[email protected]> |
Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : type-holes-branch http://hackage.haskell.org/trac/ghc/changeset/d22ae0e52bda330249e96e320261315809a849a3 >--------------------------------------------------------------- commit d22ae0e52bda330249e96e320261315809a849a3 Author: Thijs Alkemade <[email protected]> Date: Wed Dec 21 18:02:09 2011 +0100 Storing the TyVar was wrong, it has to store the type. >--------------------------------------------------------------- compiler/typecheck/TcExpr.lhs | 8 ++++---- compiler/typecheck/TcRnDriver.lhs | 5 +++-- compiler/typecheck/TcRnTypes.lhs | 2 +- 3 files changed, 8 insertions(+), 7 deletions(-) diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs index def1d57..91926b6 100644 --- a/compiler/typecheck/TcExpr.lhs +++ b/compiler/typecheck/TcExpr.lhs @@ -223,12 +223,12 @@ tcExpr (HsType ty) _ tcExpr HsHole res_ty = do { liftIO $ putStrLn ("tcExpr.HsHole: " ++ (showSDoc $ ppr $ res_ty)) ; printTy res_ty ; + (g, l) <- getEnvs ; + holes <- readTcRef $ tcl_holes l ; + writeTcRef (tcl_holes l) (res_ty : holes) ; return HsHole } where printTy (TyVarTy ty) = let (MetaTv _ io) = tcTyVarDetails ty in - do (g, l) <- getEnvs ; - holes <- readTcRef $ tcl_holes l ; - writeTcRef (tcl_holes l) (ty : holes) ; - meta <- readTcRef io + do 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 2003ff6..200810d 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -1430,8 +1430,9 @@ tcRnExpr hsc_env ictxt rdr_expr (g, l) <- getEnvs ; holes <- readTcRef $ tcl_holes l ; - 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 ("tcRnExpr1.5: " ++ (showSDoc $ ppr $ holes)) ; + zonked_holes <- zonkTcTypes $ map (\ty -> mkForAllTys qtvs (mkPiTypes dicts ty)) $ holes ; + liftIO $ putStrLn ("tcRnExpr2: " ++ (showSDoc $ ppr $ 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 21536bb..2ef124e 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 [TyVar] + tcl_holes :: TcRef [Type] } type TcTypeEnv = NameEnv TcTyThing