Make constructor wrappers inline only during the final phase

For case-of-known constructor to continue triggering early,
exprIsConApp_maybe is now capable of looking through lets and cases.

See #15840

7 files changed, 42 insertions, 5 deletions

diff --git a/testsuite/tests/deSugar/should_compile/T2431.stderr b/testsuite/tests/deSugar/should_compile/T2431.stderr
index 54308c6a5b..30b5f8c358 100644
--- a/testsuite/tests/deSugar/should_compile/T2431.stderr
+++ b/testsuite/tests/deSugar/should_compile/T2431.stderr
@@ -4,7 +4,7 @@ Result size of Tidy Core
   = {terms: 63, types: 43, coercions: 1, joins: 0/0}
 
 -- RHS size: {terms: 2, types: 4, coercions: 1, joins: 0/0}
-T2431.$WRefl [InlPrag=INLINE[2]] :: forall a. a :~: a
+T2431.$WRefl [InlPrag=INLINE[0]] :: forall a. a :~: a
 [GblId[DataConWrapper],
  Caf=NoCafRefs,
  Str=m,
@@ -110,6 +110,3 @@ T2431.$tc'Refl
       $tc'Refl2
       1#
       $krep3
-
-
-
diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr
index 5332a3e02b..41f67dc1d1 100644
--- a/testsuite/tests/simplCore/should_compile/T7360.stderr
+++ b/testsuite/tests/simplCore/should_compile/T7360.stderr
@@ -4,7 +4,7 @@ Result size of Tidy Core
   = {terms: 114, types: 53, coercions: 0, joins: 0/0}
 
 -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
-T7360.$WFoo3 [InlPrag=INLINE[2]] :: Int -> Foo
+T7360.$WFoo3 [InlPrag=INLINE[0]] :: Int -> Foo
 [GblId[DataConWrapper],
  Arity=1,
  Caf=NoCafRefs,
diff --git a/testsuite/tests/simplCore/should_run/T15840.hs b/testsuite/tests/simplCore/should_run/T15840.hs
new file mode 100644
index 0000000000..e844f9db5b
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T15840.hs
@@ -0,0 +1,14 @@
+module Main (main) where
+
+data T = MkT !Bool
+
+f :: T -> Bool
+f _ = False
+{-# NOINLINE f #-}
+
+{-# RULES "non-det" [1] forall x. f (MkT x) = x #-}
+
+main :: IO ()
+main = print (f (MkT True))
+-- Prints `True` if the rule fires, or `False` is the wrapper for `MkT` inlines
+-- in phase 2, preventing the rule from being triggered in phase 1.
diff --git a/testsuite/tests/simplCore/should_run/T15840.stdout b/testsuite/tests/simplCore/should_run/T15840.stdout
new file mode 100644
index 0000000000..0ca95142bb
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T15840.stdout
@@ -0,0 +1 @@
+True
diff --git a/testsuite/tests/simplCore/should_run/T15840a.hs b/testsuite/tests/simplCore/should_run/T15840a.hs
new file mode 100644
index 0000000000..ade75b6ac4
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T15840a.hs
@@ -0,0 +1,22 @@
+module Main (main) where
+
+data T = MkT !Bool
+
+f :: Bool -> IO ()
+f _ = putStrLn "The rule triggered before case-of-known-constructor could take effect (bad!)"
+{-# NOINLINE f #-}
+
+g :: IO ()
+g = putStrLn "Case-of-known-constructor triggered (good!)"
+
+{-# RULES "non-det" [~0] f True = g #-}
+
+main :: IO ()
+main =
+  case MkT True of
+    MkT x -> f x
+-- What we want to see is case-of-known-constructor triggering before phase 0
+-- (when the wrapper for MkT is allowed to be inlined). If it is, then the rule
+-- will see `f True` and trigger, and `g` will be run. If it isn't then `f True`
+-- will only appear at phase 0, when the rule cannot trigger, hence `f` will be
+-- run.
diff --git a/testsuite/tests/simplCore/should_run/T15840a.stdout b/testsuite/tests/simplCore/should_run/T15840a.stdout
new file mode 100644
index 0000000000..54601ba9d1
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T15840a.stdout
@@ -0,0 +1 @@
+Case-of-known-constructor triggered (good!)
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index 0a74c628c7..f8089438c5 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -87,3 +87,5 @@ test('T14894', [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(1
 test('T14965', normal, compile_and_run, [''])
 test('T15114', only_ways('optasm'), compile_and_run, [''])
 test('T15436', normal, compile_and_run, [''])
+test('T15840', normal, compile_and_run, [''])
+test('T15840a', normal, compile_and_run, [''])