[commit: ghc] wip/rae-new-coercible: Search through equalities when rewriting (7adf24e)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/rae-new-coercible
Link       : http://ghc.haskell.org/trac/ghc/changeset/7adf24eb072fd3cafbb7da4f4d11e5484982c6c0/ghc

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

commit 7adf24eb072fd3cafbb7da4f4d11e5484982c6c0
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Fri Dec 5 15:52:54 2014 -0500

    Search through equalities when rewriting


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

7adf24eb072fd3cafbb7da4f4d11e5484982c6c0
 compiler/typecheck/TcFlatten.lhs | 10 ++++++----
 compiler/typecheck/TcSMonad.lhs  | 26 +++++++++++++-------------
 2 files changed, 19 insertions(+), 17 deletions(-)

diff --git a/compiler/typecheck/TcFlatten.lhs b/compiler/typecheck/TcFlatten.lhs
index a070af5..4849332 100644
--- a/compiler/typecheck/TcFlatten.lhs
+++ b/compiler/typecheck/TcFlatten.lhs
@@ -32,6 +32,7 @@ import MonadUtils   ( zipWithAndUnzipM )
 import Bag
 import FastString
 import Control.Monad( when, liftM )
+import Data.List ( find )
 \end{code}
 
 
@@ -939,10 +940,11 @@ flattenTyVarOuter fmode tv
     -- See Note [Applying the inert substitution]
     do { ieqs <- getInertEqs (fe_eq_rel fmode)
        ; case lookupVarEnv ieqs tv of
-           Just (ct:_)   -- If the first doesn't work,
-                         -- the subsequent ones won't either
-             | CTyEqCan { cc_ev = ctev, cc_tyvar = tv, cc_rhs = rhs_ty } <- ct
-             , eqCanRewriteFlavour (ctEvFlavour ctev) (fe_flavour fmode)
+           Just cts
+               -- we need to search for one that can rewrite, because you
+               -- can have, for example, a Derived among a bunch of Wanteds
+             | Just (CTyEqCan { cc_ev = ctev, cc_tyvar = tv, cc_rhs = rhs_ty })
+                 <- find ((`eqCanRewriteFlavour` fe_flavour fmode) . ctFlavour) cts
              ->  do { traceTcS "Following inert tyvar" (ppr tv <+> equals <+> ppr rhs_ty $$ ppr ctev)
                        -- See Note [Flattener smelliness]
                     ; return (Right (rhs_ty, mkTcSymCo (ctEvCoercion ctev), False)) }
diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs
index 89860ed..da11cf9 100644
--- a/compiler/typecheck/TcSMonad.lhs
+++ b/compiler/typecheck/TcSMonad.lhs
@@ -423,16 +423,18 @@ data InertCans
        }
 
 type EqualCtList = [Ct]
--- EqualCtList invariants:
---    * All are equalities
---    * All these equalities have the same LHS
---    * The list is never empty
---    * No element of the list can rewrite any other
---
--- From the fourth invariant it follows that the list is
---   - A single Given, or
---   - Multiple Wanteds, or
---   - Multiple Deriveds
+{-
+Note [EqualCtList invariants]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+    * All are equalities
+    * All these equalities have the same LHS
+    * The list is never empty
+    * No element of the list can rewrite any other
+
+ From the fourth invariant it follows that the list is
+   - A single Given, or
+   - Any number of Wanteds, along with 0 or 1 Derived
+-}
 
 -- The Inert Set
 data InertSet
@@ -498,9 +500,7 @@ emptyInert
 ---------------
 addInertCan :: InertCans -> Ct -> InertCans
 -- Precondition: item /is/ canonical
-addInertCan ics item@(CTyEqCan { cc_eq_rel = eq_rel
-                               , cc_tyvar  = tv
-                               , cc_rhs    = rhs })
+addInertCan ics item@(CTyEqCan { cc_eq_rel = eq_rel })
   = case eq_rel of
       NomEq  -> ics { inert_eqs      = add_eq (inert_eqs ics)      item }
       ReprEq -> ics { inert_repr_eqs = add_eq (inert_repr_eqs ics) item }