Mark DataCon wrappers CONLIKE

Now that DataCon wrappers don’t inline until phase 0 (see commit
b78cc64e923716ac0512c299f42d4d0012306c05), it’s important that
case-of-known-constructor and RULE matching be able to see saturated
applications of DataCon wrappers in unfoldings. Making them conlike is a
natural way to do it, since they are, in fact, precisely the sort of
thing the CONLIKE pragma exists to solve.

Fixes #18012.

This also bumps the version of the parsec submodule to incorporate a
patch that avoids a metric increase on the haddock perf tests. The
increase was not really a flaw in this patch, as parsec was implicitly
relying on inlining heuristics. The patch to parsec just adds some
INLINABLE pragmas, and we get a nice performance bump out of it (well
beyond the performance we lost from this patch).

Metric Decrease:
    T12234
    WWRec
    haddock.Cabal
    haddock.base
    haddock.compiler

7 files changed, 51 insertions, 5 deletions

diff --git a/testsuite/tests/deSugar/should_compile/T2431.stderr b/testsuite/tests/deSugar/should_compile/T2431.stderr
index 608b26b793..08946c5cd3 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[0]] :: forall a. a :~: a
+T2431.$WRefl [InlPrag=INLINE[0] CONLIKE] :: forall a. a :~: a
 [GblId[DataConWrapper],
  Caf=NoCafRefs,
  Cpr=m1,
@@ -110,3 +110,6 @@ T2431.$tc'Refl
       $tc'Refl2
       1#
       $krep3
+
+
+
diff --git a/testsuite/tests/simplCore/should_compile/T18013.stderr b/testsuite/tests/simplCore/should_compile/T18013.stderr
index 677c08e7d9..42f517b9ea 100644
--- a/testsuite/tests/simplCore/should_compile/T18013.stderr
+++ b/testsuite/tests/simplCore/should_compile/T18013.stderr
@@ -120,11 +120,11 @@ Rule fired: mkRule @(_, ()) (T18013a)
 Rule fired: Class op fmap (BUILTIN)
 Rule fired: mkRule @((), _) (T18013a)
 Rule fired: Class op fmap (BUILTIN)
-Rule fired: mkRule @(_, ()) (T18013a)
+Rule fired: mkRule @((), _) (T18013a)
 Rule fired: Class op fmap (BUILTIN)
 Rule fired: mkRule @(_, ()) (T18013a)
 Rule fired: Class op fmap (BUILTIN)
-Rule fired: mkRule @((), _) (T18013a)
+Rule fired: mkRule @(_, ()) (T18013a)
 Rule fired: Class op fmap (BUILTIN)
 
 ==================== Tidy Core ====================
diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr
index 45c88f376e..a5765d480a 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: 106, types: 47, coercions: 0, joins: 0/0}
 
 -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
-T7360.$WFoo3 [InlPrag=INLINE[0]] :: Int -> Foo
+T7360.$WFoo3 [InlPrag=INLINE[0] CONLIKE] :: Int -> Foo
 [GblId[DataConWrapper],
  Arity=1,
  Caf=NoCafRefs,
diff --git a/testsuite/tests/simplCore/should_run/T18012.hs b/testsuite/tests/simplCore/should_run/T18012.hs
new file mode 100644
index 0000000000..9118b75ff4
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T18012.hs
@@ -0,0 +1,41 @@
+module Main (main) where
+
+{- This program is designed to check that case-of-known-constructor
+fires even if an application of a DataCon wrapper is floated out:
+
+  * The early FloatOut pass will float `D False` out of `g`, since
+    it’s a constant, non-trivial expression.
+
+  * But since `D` is strict, the floated-out expression will actually
+    be `$WD False`.
+
+  * In simplifier phase 2, `f` will be inlined into `g`, leading to a
+    case expression that scrutinizes the floated-out binding.
+
+  * If case-of-known-constructor fires, we’ll end up with `notRule
+    False`, the RULE will fire, and we get True.
+
+  * If it doesn’t fire at phase 2, it will fire later at phase 0 when
+    we inline the DataCon wrapper. But now the RULE is inactive, so
+    we’ll end up with False instead.
+
+We want case-of-known-constructor to fire early, so we want the output
+to be True. See #18012 for more details. -}
+
+main :: IO ()
+main = print (g ())
+
+data T = D !Bool
+
+notRule :: Bool -> Bool
+notRule x = x
+{-# INLINE [0] notRule #-}
+{-# RULES "notRule/False" [~0] notRule False = True #-}
+
+f :: T -> () -> Bool
+f (D a) () = notRule a
+{-# INLINE [100] f #-} -- so it isn’t inlined before FloatOut
+
+g :: () -> Bool
+g x = f (D False) x
+{-# NOINLINE g #-}
diff --git a/testsuite/tests/simplCore/should_run/T18012.stdout b/testsuite/tests/simplCore/should_run/T18012.stdout
new file mode 100644
index 0000000000..0ca95142bb
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T18012.stdout
@@ -0,0 +1 @@
+True
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index d101bff84b..210949d9c6 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -93,3 +93,4 @@ test('T15840a', normal, compile_and_run, [''])
 test('T16066', exit_code(1), compile_and_run, ['-O1'])
 test('T17206', exit_code(1), compile_and_run, [''])
 test('T17151', [], multimod_compile_and_run, ['T17151', ''])
+test('T18012', normal, compile_and_run, [''])
diff --git a/testsuite/tests/stranal/should_compile/T16029.stdout b/testsuite/tests/stranal/should_compile/T16029.stdout
index 5aae1ff281..26c2973852 100644
--- a/testsuite/tests/stranal/should_compile/T16029.stdout
+++ b/testsuite/tests/stranal/should_compile/T16029.stdout
@@ -1,4 +1,4 @@
-T16029.$WMkT [InlPrag=INLINE[0]] :: Int -> Int -> T
+T16029.$WMkT [InlPrag=INLINE[0] CONLIKE] :: Int -> Int -> T
          Tmpl= \ (dt [Occ=Once!] :: Int) (dt [Occ=Once!] :: Int) ->
   = \ (dt [Occ=Once!] :: Int) (dt [Occ=Once!] :: Int) ->
   :: GHC.Prim.Int# -> GHC.Prim.Int#