[Git][ghc/ghc][wip/9.4.6-backports] Refactor the simplifier a bit to fix #22761

[Zubin (@wz1000)]

Zubin pushed to branch wip/9.4.6-backports at Glasgow Haskell Compiler / GHC


Commits:
47a0ba63 by Simon Peyton Jones at 2023-07-27T13:51:49+05:30
Refactor the simplifier a bit to fix #22761

The core change in this commit, which fixes #22761, is that

* In a Core rule, ru_rhs is always occ-analysed.

This means adding a couple of calls to occurAnalyseExpr when
building a Rule, in
* GHC.Core.Rules.mkRule
* GHC.Core.Opt.Simplify.Iteration.simplRules

But diagosing the bug made me stare carefully at the code of the
Simplifier, and I ended up doing some only-loosely-related refactoring.

* I think that RULES could be lost because not every code path
  did addBndrRules

* The code around lambdas was very convoluted

It's mainly moving deck chairs around, but I like it more now.

(cherry picked from commit e45eb82830d6de4d09abb548e190be980dd001b4)
(cherry picked from commit e0f3aec8f4537fb75f2b38db0da6b7b52d8d29d6)

- - - - -


5 changed files:

- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/Core/Rules.hs
- + testsuite/tests/simplCore/should_compile/T22761.hs
- + testsuite/tests/simplCore/should_compile/T22761a.hs
- testsuite/tests/simplCore/should_compile/all.T


Changes:

=====================================
compiler/GHC/Core/Opt/Simplify.hs
=====================================
@@ -4299,7 +4299,9 @@ simplRules env mb_new_id rules bind_cxt
            ; return (rule { ru_bndrs = bndrs'
                           , ru_fn    = fn_name'
                           , ru_args  = args'
-                          , ru_rhs   = rhs' }) }
+                          , ru_rhs   = occurAnalyseExpr rhs' }) }
+                            -- Remember to occ-analyse, to drop dead code.
+                            -- See Note [OccInfo in unfoldings and rules] in GHC.Core
 
 {- Note [Simplifying the RHS of a RULE]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


=====================================
compiler/GHC/Core/Rules.hs
=====================================
@@ -50,6 +50,7 @@ import GHC.Core.Type as Type
 import GHC.Core.Coercion as Coercion
 import GHC.Core.Tidy     ( tidyRules )
 import GHC.Core.Map.Expr ( eqCoreExpr )
+import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr )
 
 import GHC.Tc.Utils.TcType  ( tcSplitTyConApp_maybe )
 import GHC.Builtin.Types    ( anyTypeOfKind )
@@ -190,13 +191,18 @@ mkRule :: Module -> Bool -> Bool -> RuleName -> Activation
 -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being
 -- compiled. See also 'GHC.Core.CoreRule'
 mkRule this_mod is_auto is_local name act fn bndrs args rhs
-  = Rule { ru_name = name, ru_fn = fn, ru_act = act,
-           ru_bndrs = bndrs, ru_args = args,
-           ru_rhs = rhs,
-           ru_rough = roughTopNames args,
-           ru_origin = this_mod,
-           ru_orphan = orph,
-           ru_auto = is_auto, ru_local = is_local }
+  = Rule { ru_name   = name
+         , ru_act    = act
+         , ru_fn     = fn
+         , ru_bndrs  = bndrs
+         , ru_args   = args
+         , ru_rhs    = occurAnalyseExpr rhs
+                       -- See Note [OccInfo in unfoldings and rules]
+         , ru_rough  = roughTopNames args
+         , ru_origin = this_mod
+         , ru_orphan = orph
+         , ru_auto   = is_auto
+         , ru_local  = is_local }
   where
         -- Compute orphanhood.  See Note [Orphans] in GHC.Core.InstEnv
         -- A rule is an orphan only if none of the variables


=====================================
testsuite/tests/simplCore/should_compile/T22761.hs
=====================================
@@ -0,0 +1,40 @@
+module T22761 where
+
+import T22761a
+
+newtype Mod m = Mod m deriving Num
+
+gcdExt :: Integer -> (Integer, Integer)
+gcdExt x = go 0 x
+  where
+    go !_ 0 = (1, 1)
+    go r _ = go r r
+
+pow :: (Num m) => Mod m -> Mod m
+pow x = x*x*x
+{-# NOINLINE [1] pow #-}
+{-# RULES
+"powMod/3/Int" forall x. pow x = x*x*x
+#-}
+
+
+-- GHC puts `boo1` after `wom1` (since they don't appear connected)
+-- Then { wom1 = foo True }  rewrites to  { wom1 = boo False }
+-- so we need to do glomming.  And that triggers the bug
+-- in the RULE for `pow`!
+--
+-- wom2/boo2 are there to still elicit the bug if
+-- GHC reverses its default ordering
+
+{-# RULES
+"wombat1"  foo True = boo1 False
+#-}
+
+wom1 = foo True
+boo1 x = x
+
+{-# RULES
+"wombat2"  foo True = boo2 False
+#-}
+boo2 x = x
+wom2 = foo True


=====================================
testsuite/tests/simplCore/should_compile/T22761a.hs
=====================================
@@ -0,0 +1,4 @@
+module T22761a where
+
+{-# NOINLINE [0] foo #-}
+foo x = x


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -398,3 +398,4 @@ test('T22112', [ grep_errmsg('never matches') ], compile, ['-O -dsuppress-unique
 test('T22491', normal, compile, ['-O2'])
 test('T21476', normal, compile, [''])
 test('T22272', normal, multimod_compile, ['T22272', '-O -fexpose-all-unfoldings -fno-omit-interface-pragmas -fno-ignore-interface-pragmas'])
+test('T22761', normal, multimod_compile, ['T22761', '-O2 -v0'])



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/47a0ba6380df28564f256323b345ebfff8944341
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/20230727/c2af381b/attachment-0001.html>