[Git][ghc/ghc][wip/T24251a] Wibbles

[Simon Peyton Jones (@simonpj)]

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


Commits:
ca405979 by Simon Peyton Jones at 2024-03-14T15:42:54+00:00
Wibbles

- - - - -


2 changed files:

- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs


Changes:

=====================================
compiler/GHC/Core/Opt/Simplify/Env.hs
=====================================
@@ -17,7 +17,7 @@ module GHC.Core.Opt.Simplify.Env (
         seDoEtaReduction, seEtaExpand, seFloatEnable, seInline, seNames,
         seOptCoercionOpts, sePedanticBottoms, sePhase, sePlatform, sePreInline,
         seRuleOpts, seRules, seUnfoldingOpts,
-        mkSimplEnv, extendIdSubst,
+        mkSimplEnv, extendIdSubst, extendCvIdSubst,
         extendTvSubst, extendCvSubst,
         zapSubstEnv, setSubstEnv, bumpCaseDepth,
         getInScope, setInScopeFromE, setInScopeFromF,
@@ -550,6 +550,10 @@ extendCvSubst env@(SimplEnv {seCvSubst = csubst}) var co
   = assert (isCoVar var) $
     env {seCvSubst = extendVarEnv csubst var co}
 
+extendCvIdSubst :: SimplEnv -> Id -> OutExpr -> SimplEnv
+extendCvIdSubst env bndr (Coercion co) = extendCvSubst env bndr co
+extendCvIdSubst env bndr rhs           = extendIdSubst env bndr (DoneEx rhs NotJoinPoint)
+
 ---------------------
 getInScope :: SimplEnv -> InScopeSet
 getInScope env = seInScope env


=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -412,9 +412,7 @@ simplAuxBind env bndr new_rhs
   -- have no NOLINE pragmas, nor RULEs
   | exprIsTrivial new_rhs  -- Short-cut for let x = y in ...
   = return ( emptyFloats env
-           , case new_rhs of
-                Coercion co -> extendCvSubst env bndr co
-                _           -> extendIdSubst env bndr (DoneEx new_rhs NotJoinPoint) )
+           , extendCvIdSubst env bndr new_rhs )  -- bndr can be a CoVar
 
   | otherwise
   = do  { -- ANF-ise the RHS
@@ -3062,10 +3060,10 @@ rebuildCase env scrut case_bndr alts@[Alt con bndrs rhs] cont
   | DEFAULT <- con
   , exprIsTrivial scrut
   , isEvaldSoon case_bndr rhs
-  , let env' = extendIdSubst env case_bndr (DoneEx scrut NotJoinPoint)
   = assert( null bndrs ) $
     do { tick (CaseElim case_bndr)
-       ; simplExprF env' rhs cont }
+       ; simplExprF (extendCvIdSubst env case_bndr scrut) rhs cont }
+                    -- case_bndr can be a CoVar
 
   -- 2a.  Dropping the case altogether, if
   --      a) it binds nothing (so it's really just a 'seq')



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ca405979ea626e3e7bcb137f356320827ff18253
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/20240314/cce4b75e/attachment-0001.html>