summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/prelude/PrelRules.hs29
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