Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-new-flavor
http://hackage.haskell.org/trac/ghc/changeset/8737d47e6c43eb8261213fe03168a69d963ee1da >--------------------------------------------------------------- commit 8737d47e6c43eb8261213fe03168a69d963ee1da Author: Dimitrios.Vytiniotis <[email protected]> Date: Tue Apr 3 13:29:55 2012 +0100 When rewriting a flavor with rewriteCtFlavor, in the case of reflexivity, avoid setting the flavor PredType to be the new PredType if the types exactly match, so that in case of failure we report errors that do not have expanded type synonyms. >--------------------------------------------------------------- compiler/typecheck/TcSMonad.lhs | 16 +++++++++++----- 1 files changed, 11 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index 01b8488..75cca7d 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -1418,11 +1418,17 @@ rewriteCtFlavor_cache _cache (Derived wl _pty_orig) pty_new _co rewriteCtFlavor_cache cache fl pty co | isTcReflCo co -- If just reflexivity then you may re-use the same variable as optimization - = return (Just $ case fl of - Derived wl _pty_orig -> Derived wl pty - Given gl ev -> Given gl (setVarType ev pty) - Wanted wl ev -> Wanted wl (setVarType ev pty) - Solved gl ev -> Solved gl (setVarType ev pty)) + = if ctFlavPred fl `eqType` pty then + -- E.g. for type synonyms we want to use the original type + -- since it's not flattened to report better error messages. + return $ Just fl + else + -- E.g. because we rewrite with a spontaneously solved one + return (Just $ case fl of + Derived wl _pty_orig -> Derived wl pty + Given gl ev -> Given gl (setVarType ev pty) + Wanted wl ev -> Wanted wl (setVarType ev pty) + Solved gl ev -> Solved gl (setVarType ev pty)) | otherwise = xCtFlavor_cache cache fl [pty] (XEvTerm ev_comp ev_decomp) cont where ev_comp [x] = mkEvCast x co _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
