[commit: ghc] ghc-8.0: Get in-scope set right in top_instantiate (5c01763)

[git at git.haskell.org]

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

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/5c01763e2fa7cd9bb5f08fad713cb03b97a07b7f/ghc

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

commit 5c01763e2fa7cd9bb5f08fad713cb03b97a07b7f
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Sat Jun 11 23:55:10 2016 +0100

    Get in-scope set right in top_instantiate
    
    ...thereby being able to replace substThetaUnchecked
    with substTheta
    
    (cherry picked from commit 7afb7adf45216701e4f645676ecc0668f64b424d)


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

5c01763e2fa7cd9bb5f08fad713cb03b97a07b7f
 compiler/typecheck/Inst.hs | 16 +++++++++++-----
 1 file changed, 11 insertions(+), 5 deletions(-)

diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs
index 49f57a5..0c854f7 100644
--- a/compiler/typecheck/Inst.hs
+++ b/compiler/typecheck/Inst.hs
@@ -172,7 +172,8 @@ topInstantiateInferred :: CtOrigin -> TcSigmaType
 -- then  wrap e :: rho
 topInstantiateInferred = top_instantiate False
 
-top_instantiate :: Bool   -- True <=> instantiate *all* variables
+top_instantiate :: Bool   -- True  <=> instantiate *all* variables
+                          -- False <=> instantiate only the invisible ones
                 -> CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)
 top_instantiate inst_all orig ty
   | not (null binders && null theta)
@@ -180,16 +181,21 @@ top_instantiate inst_all orig ty
              (inst_theta, leave_theta)
                | null leave_bndrs = (theta, [])
                | otherwise        = ([], theta)
-       ; (subst, inst_tvs') <- newMetaTyVars (map (binderVar "top_inst") inst_bndrs)
-       ; let inst_theta' = substThetaUnchecked subst inst_theta
-             sigma'      = substTyAddInScope subst (mkForAllTys leave_bndrs $
-                                                    mkFunTys leave_theta rho)
+             in_scope    = mkInScopeSet (tyCoVarsOfType ty)
+             empty_subst = mkEmptyTCvSubst in_scope
+             inst_tvs    = map (binderVar "top_inst") inst_bndrs
+       ; (subst, inst_tvs') <- mapAccumLM newMetaTyVarX empty_subst inst_tvs
+       ; let inst_theta' = substTheta subst inst_theta
+             sigma'      = substTy subst (mkForAllTys leave_bndrs $
+                                          mkFunTys leave_theta rho)
 
        ; wrap1 <- instCall orig (mkTyVarTys inst_tvs') inst_theta'
        ; traceTc "Instantiating"
                  (vcat [ text "all tyvars?" <+> ppr inst_all
                        , text "origin" <+> pprCtOrigin orig
                        , text "type" <+> ppr ty
+                       , text "theta" <+> ppr theta
+                       , text "leave_bndrs" <+> ppr leave_bndrs
                        , text "with" <+> ppr inst_tvs'
                        , text "theta:" <+>  ppr inst_theta' ])