[commit: ghc] master: Fix some substitution InScopeSets (2899aa5)

git at git.haskell.org git at git.haskell.org
Wed Jan 27 14:33:16 UTC 2016


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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/2899aa580d633103fc551e36c977720b94f5b41c/ghc

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

commit 2899aa580d633103fc551e36c977720b94f5b41c
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Mon Jan 25 22:00:47 2016 -0500

    Fix some substitution InScopeSets
    
    This is relevant to #11371.


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

2899aa580d633103fc551e36c977720b94f5b41c
 compiler/typecheck/TcHsType.hs | 2 +-
 compiler/typecheck/TcMType.hs  | 2 +-
 compiler/typecheck/TcType.hs   | 1 +
 compiler/types/TyCoRep.hs      | 4 ++++
 compiler/types/Type.hs         | 4 ++--
 5 files changed, 9 insertions(+), 4 deletions(-)

diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index 1b6d5cf..c752dba 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -847,7 +847,7 @@ tcInstBinderX :: Maybe (VarEnv Kind)
 tcInstBinderX mb_kind_info subst binder
   | Just tv <- binderVar_maybe binder
   = case lookup_tv tv of
-      Just ki -> return (extendTCvSubst subst tv ki, ki)
+      Just ki -> return (extendTCvSubstAndInScope subst tv ki, ki)
       Nothing -> do { (subst', tv') <- newMetaTyVarX subst tv
                     ; return (subst', mkTyVarTy tv') }
 
diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs
index a160d4e..b7fe68c 100644
--- a/compiler/typecheck/TcMType.hs
+++ b/compiler/typecheck/TcMType.hs
@@ -693,7 +693,7 @@ newMetaTyVarX subst tyvar
                        -- See Note [Name of an instantiated type variable]
               kind   = substTyUnchecked subst (tyVarKind tyvar)
               new_tv = mkTcTyVar name kind details
-        ; return (extendTCvSubst (extendTCvInScope subst new_tv) tyvar
+        ; return (extendTCvSubstAndInScope subst tyvar
                    (mkTyVarTy new_tv)
                  , new_tv)
         }
diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs
index a3e449d..796c042 100644
--- a/compiler/typecheck/TcType.hs
+++ b/compiler/typecheck/TcType.hs
@@ -145,6 +145,7 @@ module TcType (
   mkOpenTCvSubst, zipOpenTCvSubst,
   mkTopTCvSubst, notElemTCvSubst, unionTCvSubst,
   getTvSubstEnv, setTvSubstEnv, getTCvInScope, extendTCvInScope,
+  extendTCvInScopeList, extendTCvInScopeSet, extendTCvSubstAndInScope,
   Type.lookupTyVar, Type.extendTCvSubst, Type.substTyVarBndr,
   extendTCvSubstList, isInScope, mkTCvSubst, zipTyEnv, zipCoEnv,
   Type.substTy, substTys, substTyWith, substTyWithCoVars,
diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index 08d3b79..dcffbe0 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -1864,7 +1864,11 @@ substTy subst@(TCvSubst in_scope tenv cenv) ty
   | otherwise = ASSERT2( isValidTCvSubst subst,
                          text "in_scope" <+> ppr in_scope $$
                          text "tenv" <+> ppr tenv $$
+                         text "tenvFVs"
+                           <+> ppr (tyCoVarsOfTypes $ varEnvElts tenv) $$
                          text "cenv" <+> ppr cenv $$
+                         text "cenvFVs"
+                           <+> ppr (tyCoVarsOfCos $ varEnvElts cenv) $$
                          text "ty" <+> ppr ty )
                 ASSERT2( typeFVsInScope,
                          text "in_scope" <+> ppr in_scope $$
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 81e5773..3992a71 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -154,8 +154,8 @@ module Type (
         notElemTCvSubst,
         getTvSubstEnv, setTvSubstEnv,
         zapTCvSubst, getTCvInScope,
-        extendTCvInScope, extendTCvInScopeList,
-        extendTCvSubst, extendTCvSubstList,
+        extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet,
+        extendTCvSubst, extendTCvSubstList, extendTCvSubstAndInScope,
         isInScope, composeTCvSubstEnv, composeTCvSubst, zipTyEnv, zipCoEnv,
         isEmptyTCvSubst, unionTCvSubst,
 



More information about the ghc-commits mailing list