PrelRules: Ensure that string unpack/append rule fires with source noteswip/T16740

Previously the presence of source notes could hide nested applications
of `unpackFoldrCString#` from our constant folding logic. For instance,
consider the expression:

```haskell
unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)
```

Specifically, ticks appearing in two places can defeat the rule:

  a. Surrounding the inner application of `unpackFoldrCString#`
  b. Surrounding the fold function, `c`

The latter caused the `str_rules` testcase to fail when `base` was built
with `-g3`.

Fixes #16740.

1 files changed, 18 insertions, 11 deletions

diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs
index bd18bfec63..943d8dc3b6 100644
--- a/compiler/prelude/PrelRules.hs
+++ b/compiler/prelude/PrelRules.hs
@@ -41,7 +41,7 @@ import TyCon       ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon
                    , isNewTyCon, unwrapNewTyCon_maybe, tyConDataCons
                    , tyConFamilySize )
 import DataCon     ( dataConTagZ, dataConTyCon, dataConWorkId )
-import CoreUtils   ( cheapEqExpr, exprIsHNF, exprType )
+import CoreUtils   ( cheapEqExpr, cheapEqExpr', exprIsHNF, exprType, stripTicksTop, stripTicksTopT, mkTicks )
 import CoreUnfold  ( exprIsConApp_maybe )
 import Type
 import OccName     ( occNameFS )
@@ -1368,20 +1368,27 @@ match_append_lit _ id_unf _
         [ Type ty1
         , lit1
         , c1
-        , Var unpk `App` Type ty2
-                   `App` lit2
-                   `App` c2
-                   `App` n
+        , e2
         ]
-  | unpk `hasKey` unpackCStringFoldrIdKey &&
-    c1 `cheapEqExpr` c2
+  -- N.B. Ensure that we strip off any ticks (e.g. source notes) from the
+  -- `lit` and `c` arguments, lest this may fail to fire when building with
+  -- -g3. See #16740.
+  | (strTicks, Var unpk `App` Type ty2
+                        `App` lit2
+                        `App` c2
+                        `App` n) <- stripTicksTop tickishFloatable e2
+  , unpk `hasKey` unpackCStringFoldrIdKey
+  , cheapEqExpr' tickishFloatable c1 c2
+  , (c1Ticks, c1') <- stripTicksTop tickishFloatable c1
+  , c2Ticks <- stripTicksTopT tickishFloatable c2
   , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1
   , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2
   = ASSERT( ty1 `eqType` ty2 )
-    Just (Var unpk `App` Type ty1
-                   `App` Lit (LitString (s1 `BS.append` s2))
-                   `App` c1
-                   `App` n)
+    Just $ mkTicks strTicks
+         $ Var unpk `App` Type ty1
+                    `App` Lit (LitString (s1 `BS.append` s2))
+                    `App` mkTicks (c1Ticks ++ c2Ticks) c1'
+                    `App` n
 
 match_append_lit _ _ _ _ = Nothing