Commit a657543c authored by Ben Gamari's avatar Ben Gamari 🐢 Committed by Marge Bot

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

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.
parent fc6b23be
Pipeline #7052 passed with stages
in 279 minutes and 9 seconds
......@@ -42,7 +42,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 )
......@@ -1367,20 +1367,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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment