[Git][ghc/ghc][master] Fix #23567, a specializer bug

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00
Fix #23567, a specializer bug

Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834

The testcase isn't ideal because it doesn't detect the bug in master,
unless doNotUnbox is removed as in
https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692.
But I have confirmed that with that modification, it fails before
and passes afterwards.

- - - - -


4 changed files:

- compiler/GHC/Core/Opt/Specialise.hs
- + testsuite/tests/simplCore/should_compile/T23567.hs
- + testsuite/tests/simplCore/should_compile/T23567A.hs
- testsuite/tests/simplCore/should_compile/all.T


Changes:

=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -1495,7 +1495,9 @@ specBind top_lvl env (NonRec fn rhs) do_body
              -- Destroying demand info is not terrible; specialisation is
              -- always followed soon by demand analysis.
 
-             body_env2 = body_env1 `extendInScope` fn3
+             body_env2 = body_env1 `bringFloatedDictsIntoScope` ud_binds rhs_uds
+                                   `extendInScope` fn3
+                                   -- bringFloatedDictsIntoScope: see #23567
 
        ; (body', body_uds) <- do_body body_env2
 


=====================================
testsuite/tests/simplCore/should_compile/T23567.hs
=====================================
@@ -0,0 +1,10 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -funfolding-use-threshold=111640 -fmax-simplifier-iterations=2 #-}
+
+module T23567 where
+
+import T23567A
+
+instance (MonadIO m) => CacheRWM2 (ReaderT (StateT m)) where
+  p = runCacheBuildM
+  {-# NOINLINE p #-}


=====================================
testsuite/tests/simplCore/should_compile/T23567A.hs
=====================================
@@ -0,0 +1,27 @@
+module T23567A where
+
+class Appl f where
+  pur :: f
+  ast :: f -> f
+
+class Appl f => Mona f where
+  unused :: f
+
+class Mona f => MonadIO f where
+  unused2 :: f
+
+newtype StateT m = StateT { runStateT :: m }
+  deriving (Mona, MonadIO)
+
+instance (Appl m, Appl m) => Appl (StateT m) where
+    pur = pur
+    ast x = x
+
+newtype ReaderT m = ReaderT { runReaderT :: m }
+  deriving (Appl, Mona, MonadIO)
+
+class CacheRWM2 m where
+  p :: m
+
+runCacheBuildM :: (MonadIO m) => m
+runCacheBuildM = ast pur


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -490,3 +490,4 @@ test('T23491c', [extra_files(['T23491.hs']), grep_errmsg(r'Liberate case')], mul
 test('T23491d', [extra_files(['T23491.hs']), grep_errmsg(r'Static argument')], multimod_compile, ['T23491', '-fstatic-argument-transformation -ddump-static-argument-transformation'])
 test('T23074', normal, compile, ['-O -ddump-rules'])
 test('T23272', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23272.script'])
+test('T23567', [extra_files(['T23567A.hs'])], multimod_compile, ['T23567', '-O -v0'])



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf9b9de0685e23c191722dfdb78d28b44f1cba05
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/20230712/29e8f89a/attachment-0001.html>