From 2f223e8f4a4e2fb22a8bb0638cd48256e9f2f0e2 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Fri, 17 Jul 2009 15:57:22 +0000 Subject: [PATCH] Fix Trac #3346: tcSimplify for LHS of RULES with type equalities --- compiler/typecheck/TcSimplify.lhs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs index 74952e4..8632895 100644 --- a/compiler/typecheck/TcSimplify.lhs +++ b/compiler/typecheck/TcSimplify.lhs @@ -1587,13 +1587,23 @@ Simpler, maybe, but alas not simple (see Trac #2494) tcSimplifyRuleLhs :: [Inst] -> TcM ([Inst], TcDictBinds) tcSimplifyRuleLhs wanteds = do { wanteds' <- zonkInsts wanteds - ; (irreds, binds) <- go [] emptyBag wanteds' + + -- Simplify equalities + -- It's important to do this: Trac #3346 for example + ; (_, wanteds'', tybinds, binds1) <- tcReduceEqs [] wanteds' + ; execTcTyVarBinds tybinds + + -- Simplify other constraints + ; (irreds, binds2) <- go [] emptyBag wanteds'' + + -- Report anything that is left ; let (dicts, bad_irreds) = partition isDict irreds ; traceTc (text "tcSimplifyrulelhs" <+> pprInsts bad_irreds) ; addNoInstanceErrs (nub bad_irreds) -- The nub removes duplicates, which has -- not happened otherwise (see notes above) - ; return (dicts, binds) } + + ; return (dicts, binds1 `unionBags` binds2) } where go :: [Inst] -> TcDictBinds -> [Inst] -> TcM ([Inst], TcDictBinds) go irreds binds [] -- 1.7.10.4