Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : type-holes-branch
http://hackage.haskell.org/trac/ghc/changeset/70128bd6709643dc7ecaaf8c0b810995be28b844 >--------------------------------------------------------------- commit 70128bd6709643dc7ecaaf8c0b810995be28b844 Author: Thijs Alkemade <[email protected]> Date: Fri Jul 27 11:42:18 2012 +0200 All tyvars that occur in a hole are now zonked and tidied before creating the hole error messages. This ensures all free type variables in all holes are consistently named. I'm not sure this is the ideal solution here, as it means all type variables in a hole get zonked and tidied (at least) twice, but it's the least invasive way to do it. >--------------------------------------------------------------- compiler/typecheck/TcErrors.lhs | 12 +++++++----- 1 files changed, 7 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs index 64d2847..b05df0b 100644 --- a/compiler/typecheck/TcErrors.lhs +++ b/compiler/typecheck/TcErrors.lhs @@ -156,10 +156,12 @@ reportTidyWanteds ctxt insols flats implics } else do { - mapBagM_ (deferToRuntime ev_binds_var ctxt mkHoleDeferredError) - holes - ; reportInsolsAndFlats ctxt (filterBag (not.isHole) insols) (filterBag (not.isHole) flats) - ; mapBagM_ (reportImplic ctxt) implics + zonked_tyvars <- mapBagM zonkTyVarsAndFV $ mapBag tyVarsOfCt holes + ; let new_env = foldrBag (\vars env -> let (env', _) = tidyOpenTyVars env (varSetElems vars) in env') (cec_tidy ctxt) zonked_tyvars + ; traceTc "reportTidyWanteds" (ppr new_env) + ; mapBagM_ (deferToRuntime ev_binds_var (ctxt { cec_tidy = new_env }) mkHoleDeferredError) holes + ; reportInsolsAndFlats (ctxt { cec_tidy = new_env }) (filterBag (not.isHole) insols) (filterBag (not.isHole) flats) + ; mapBagM_ (reportImplic (ctxt { cec_tidy = new_env })) implics } } where isHole ct = case ct of @@ -451,7 +453,7 @@ mkHoleDeferredError ctxt ct@(CHoleCan {}) } get_thing :: TcTyThing -> Maybe (Var, TcType) - get_thing (ATcId thing_id NotTopLevel _) = Just (thing_id, varType thing_id) + get_thing (ATcId thing_id _ _) = Just (thing_id, varType thing_id) get_thing _ = Nothing ppr_local_bind :: (Var, Type) -> SDoc _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
