[Git][ghc/ghc][wip/T25445] Wibble

[Simon Peyton Jones (@simonpj)]

Simon Peyton Jones pushed to branch wip/T25445 at Glasgow Haskell Compiler / GHC


Commits:
287ea40a by Simon Peyton Jones at 2024-11-08T22:02:06+00:00
Wibble

- - - - -


2 changed files:

- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/TyCo/Subst.hs


Changes:

=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -3439,8 +3439,8 @@ addInScopeId in_id out_ty thing_inside
   where
     add env@(LE { le_in_vars = id_vars, le_joins = join_set
                 , le_ue_aliases = aliases, le_subst = subst })
-      | isEmptyTCvSubst subst = (in_id,  env1)
-      | otherwise             = (out_id, env1 { le_subst = subst' })
+      | isEmptyTCvSubst subst = (in_id,  env1 { le_subst = subst `delSubstInScope` in_id })
+      | otherwise             = (out_id, env1 { le_subst = subst `extendSubstInScope` out_id})
         -- isEmptyTCvSubst: short-cut when the types of in_id and out_id are identical
       where
         env1 = env { le_in_vars = in_vars', le_joins = join_set', le_ue_aliases = aliases' }
@@ -3453,7 +3453,6 @@ addInScopeId in_id out_ty thing_inside
            -- Occurrences of 'x' in e2 shouldn't count as occurrences of e1.
 
         out_id = setIdType in_id out_ty
-        subst' = subst `extendSubstInScope` out_id
 
         join_set'
           | isJoinId out_id = extendVarSet join_set in_id -- Overwrite with new arity


=====================================
compiler/GHC/Core/TyCo/Subst.hs
=====================================
@@ -17,7 +17,7 @@ module GHC.Core.TyCo.Subst
         getTvSubstEnv, getIdSubstEnv,
         getCvSubstEnv, substInScopeSet, setInScope, getSubstRangeTyCoFVs,
         isInScope, elemSubst, notElemSubst, zapSubst,
-        extendSubstInScope, extendSubstInScopeList, extendSubstInScopeSet,
+        extendSubstInScope, extendSubstInScopeList, extendSubstInScopeSet, delSubstInScope,
         extendTCvSubst, extendTCvSubstWithClone,
         extendCvSubst, extendCvSubstWithClone,
         extendTvSubst, extendTvSubstWithClone,
@@ -339,6 +339,11 @@ extendSubstInScope (Subst in_scope ids tvs cvs) v
   = Subst (in_scope `extendInScopeSet` v)
           ids tvs cvs
 
+delSubstInScope  :: Subst -> Var -> Subst
+delSubstInScope (Subst in_scope ids tvs cvs) v
+  = Subst (in_scope `delInScopeSet` v)
+          ids tvs cvs
+
 -- | Add the 'Var's to the in-scope set: see also 'extendInScope'
 extendSubstInScopeList :: Subst -> [Var] -> Subst
 extendSubstInScopeList (Subst in_scope ids tvs cvs) vs



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/287ea40afb6d60bac1d88d999655894f69cc9757

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/287ea40afb6d60bac1d88d999655894f69cc9757
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241108/8ea10f25/attachment-0001.html>