[commit: ghc] wip/impredicativity: Do right unification check in lookupInstEnv' (eeab23c)

[git at git.haskell.org]

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

On branch  : wip/impredicativity
Link       : http://ghc.haskell.org/trac/ghc/changeset/eeab23c3b3958de046a4e56761140ce7ade83010/ghc

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

commit eeab23c3b3958de046a4e56761140ce7ade83010
Author: Alejandro Serrano <trupill at gmail.com>
Date:   Wed Jul 15 15:41:57 2015 +0200

    Do right unification check in lookupInstEnv'
    
    Prior to this commit, lookupInstEnv' would not take into account
    the lazy equations when checking for unifying classes.
    For example, if you had instances
      instance Monoid Bool
      instance Monoid Int
    and you want to check Monoid a where a <~ Bool, the system
    incorrectly found that both instances unified. But only one
    should do it!


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

eeab23c3b3958de046a4e56761140ce7ade83010
 compiler/types/InstEnv.hs | 3 ++-
 compiler/types/Unify.hs   | 8 +++++++-
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/compiler/types/InstEnv.hs b/compiler/types/InstEnv.hs
index b265b1a..d30e346 100644
--- a/compiler/types/InstEnv.hs
+++ b/compiler/types/InstEnv.hs
@@ -820,11 +820,12 @@ lookupInstEnv' ie vis_mods cls tys leqs
                 -- Unification will break badly if the variables overlap
                 -- They shouldn't because we allocate separate uniques for them
                 -- See Note [Template tyvars are fresh]
-        case tcUnifyTys instanceBindFun tpl_tys tys of
+        case tcUnifyTys instanceBindFun tpl_tys (substTys subst tys) of
             Just _   -> find ms (item:us) rest
             Nothing  -> find ms us        rest
       where
         tpl_tv_set = mkVarSet tpl_tvs
+        subst = lazyEqsToSubst leqs
 
     ----------------
     lookup_tv :: TvSubst -> TyVar -> DFunInstType
diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs
index aa71ba8..e3574ee 100644
--- a/compiler/types/Unify.hs
+++ b/compiler/types/Unify.hs
@@ -10,7 +10,7 @@ module Unify (
         ruleMatchTyX, tcMatchPreds,
         MatchResult, MatchResult'(..),
 
-        LazyEqs, noLazyEqs,
+        LazyEqs, noLazyEqs, lazyEqsToSubst,
         MatchEnv(..), matchList,
 
         typesCantMatch,
@@ -73,6 +73,12 @@ type LazyEqs l = Bag (Type, Type, l)
 noLazyEqs :: LazyEqs l
 noLazyEqs = emptyBag
 
+lazyEqsToSubst :: LazyEqs l -> TvSubst
+lazyEqsToSubst leqs = go (bagToList leqs)
+  where go [] = emptyTvSubst
+        go ((ty1,ty2,_):rs)
+          = extendTvSubst (go rs) (getTyVar "lazyEqsToSubst" ty1) ty2
+
 data MatchEnv l
   = ME  { me_tmpls :: VarSet    -- Template variables
         , me_env   :: RnEnv2    -- Renaming envt for nested foralls