Allow Core optimizations when interpreting bytecode

Tracking ticket: #23056

MR: !10399

This adds the flag `-funoptimized-core-for-interpreter`, permitting use
of the `-O` flag to enable optimizations when compiling with the
interpreter backend, like in ghci.

11 files changed, 61 insertions, 2 deletions

diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index 3496b2af5a..2099d7c100 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -387,6 +387,7 @@ data GeneralFlag
    | Opt_KeepGoing
    | Opt_ByteCode
    | Opt_ByteCodeAndObjectCode
+   | Opt_UnoptimizedCoreForInterpreter
    | Opt_LinkRts
 
    -- output style opts
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 52361abb09..84962f7868 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -3573,6 +3573,7 @@ fFlagsDeps = [
   flagSpec "write-ide-info"                   Opt_WriteHie,
   flagSpec "unbox-small-strict-fields"        Opt_UnboxSmallStrictFields,
   flagSpec "unbox-strict-fields"              Opt_UnboxStrictFields,
+  flagSpec "unoptimized-core-for-interpreter" Opt_UnoptimizedCoreForInterpreter,
   flagSpec "version-macros"                   Opt_VersionMacros,
   flagSpec "worker-wrapper"                   Opt_WorkerWrapper,
   flagSpec "worker-wrapper-cbv"               Opt_WorkerWrapperUnlift, -- See Note [Worker/wrapper for strict arguments]
@@ -3896,7 +3897,8 @@ defaultFlags settings
       Opt_DumpWithWays,
       Opt_CompactUnwind,
       Opt_ShowErrorContext,
-      Opt_SuppressStgReps
+      Opt_SuppressStgReps,
+      Opt_UnoptimizedCoreForInterpreter
     ]
 
     ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
@@ -4976,6 +4978,7 @@ makeDynFlagsConsistent dflags
            "Enabling -fPIC as it is always on for this platform"
 
  | backendForcesOptimization0 (backend dflags)
+ , gopt Opt_UnoptimizedCoreForInterpreter dflags
  , let (dflags', changed) = updOptLevelChanged 0 dflags
  , changed
     = loop dflags' ("Optimization flags are incompatible with the " ++
diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst
index e2acac340f..04bb5ca97a 100644
--- a/docs/users_guide/debugging.rst
+++ b/docs/users_guide/debugging.rst
@@ -1146,3 +1146,17 @@ Other
     be terminated. This helps narrowing down if an issue is due to tag inference
     if things go wrong. Which would otherwise be quite difficult.
 
+.. ghc-flag:: -funoptimized-core-for-interpreter
+    :shortdesc: Disable optimizations with the interpreter 
+    :reverse: -fno-unoptimized-core-for-interpreter
+    :type: dynamic
+
+    :since: 9.8.1
+
+    default: enabled
+
+    At the moment, ghci disables optimizations, because not all passes
+    are compatible with the interpreter.
+    This option can be used to override this check, e.g.
+    ``ghci -O2 -fno-unoptimized-core-for-interpreter``.
+    It is not recommended for normal use and can cause a compiler panic.
diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py
index 09ab06d469..b2353531c2 100644
--- a/testsuite/driver/testlib.py
+++ b/testsuite/driver/testlib.py
@@ -387,7 +387,7 @@ def expect_fail_for( ways: List[WayName] ):
 
 def expect_broken( bug: IssueNumber ):
     """
-    This test is a expected not to work due to the indicated issue number.
+    This test is expected not to work due to the indicated issue number.
     """
     def helper( name: TestName, opts ):
         record_broken(name, opts, bug)
diff --git a/testsuite/tests/simplCore/should_compile/T23267.hs b/testsuite/tests/simplCore/should_compile/T23267.hs
new file mode 100644
index 0000000000..02307cea5d
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T23267.hs
@@ -0,0 +1,25 @@
+module T23267 where
+
+data N = Z | S N
+
+union :: N -> ()
+union Z = ()
+union t = splitS t
+
+splitS :: N -> ()
+splitS Z = ()
+splitS (S l) = splitS l
+
+{- Results in this error:
+
+*** Core Lint errors : in result of SpecConstr ***
+T23267.hs:10:1: warning:
+    Out of scope: l_aBE :: N
+                  [LclId]
+    In the RHS of $ssplitS_sJx :: N -> ()
+    In the body of lambda with binder sc_sJw :: N
+    Substitution: <InScope = {}
+                   IdSubst   = []
+                   TvSubst   = []
+                   CvSubst   = []>
+-}
diff --git a/testsuite/tests/simplCore/should_compile/T23267.script b/testsuite/tests/simplCore/should_compile/T23267.script
new file mode 100644
index 0000000000..75e8cf5aaf
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T23267.script
@@ -0,0 +1 @@
+:load T23267
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 90e67d81fe..ae48423fa0 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -477,3 +477,4 @@ test('T23012', normal, compile, ['-O'])
 test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques'])
 test('T23024', normal, multimod_compile, ['T23024', '-O -v0'])
 test('T23026', normal, compile, ['-O'])
+test('T23267', [expect_broken(23267), only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -fspec-constr')], ghci_script, ['T23267.script'])
diff --git a/testsuite/tests/simplCore/should_run/T23056.hs b/testsuite/tests/simplCore/should_run/T23056.hs
new file mode 100644
index 0000000000..abf3d7a7be
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T23056.hs
@@ -0,0 +1,10 @@
+module Main where
+
+fun :: IO ()
+fun = pure ()
+{-# noinline fun #-}
+
+{-# rules "fun" fun = putStrLn "fun" #-}
+
+main :: IO ()
+main = fun
diff --git a/testsuite/tests/simplCore/should_run/T23056.script b/testsuite/tests/simplCore/should_run/T23056.script
new file mode 100644
index 0000000000..fdf0d3b722
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T23056.script
@@ -0,0 +1,2 @@
+:load T23056
+main
diff --git a/testsuite/tests/simplCore/should_run/T23056.stdout b/testsuite/tests/simplCore/should_run/T23056.stdout
new file mode 100644
index 0000000000..3df46ad190
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T23056.stdout
@@ -0,0 +1 @@
+fun
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index 7348e1015a..bfd5fa6261 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -112,3 +112,4 @@ test('T22998', normal, compile_and_run, ['-O0 -fspecialise -dcore-lint'])
 test('T23184', normal, compile_and_run, ['-O'])
 test('T23134', normal, compile_and_run, ['-O0 -fcatch-nonexhaustive-cases'])
 test('T23289', normal, compile_and_run, [''])
+test('T23056', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23056.script'])