diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2021-07-28 15:30:08 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-08-02 04:15:41 -0400 |
| commit | 901c79d8de49dee9562845e846e9aa3665acd6c4 (patch) | |
| tree | 56b2152bd37f96296e52c2fb766f61a6861bac6a /compiler | |
| parent | 3968cd0c9282ea88b3952133f1c0ceb29bb23e03 (diff) | |
| download | haskell-901c79d8de49dee9562845e846e9aa3665acd6c4.tar.gz | |
Lookup string literals in top-level thunks (fix #16373)
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Core/Opt/ConstantFold.hs | 14 |
1 files changed, 8 insertions, 6 deletions
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs index 421de78568..f2c9e95253 100644 --- a/compiler/GHC/Core/Opt/ConstantFold.hs +++ b/compiler/GHC/Core/Opt/ConstantFold.hs @@ -2452,18 +2452,20 @@ stripStrTopTicksT e = stripTicksTopT tickishFloatable e -- Also matches unpackCStringUtf8# match_eq_string :: RuleFun -match_eq_string _ id_unf _ - [Var unpk1 `App` lit1, Var unpk2 `App` lit2] - | unpk_key1 <- getUnique unpk1 +match_eq_string _ env _ [e1, e2] + | (ticks1, Var unpk1 `App` lit1) <- stripStrTopTicks env e1 + , (ticks2, Var unpk2 `App` lit2) <- stripStrTopTicks env e2 + , unpk_key1 <- getUnique unpk1 , unpk_key2 <- getUnique unpk2 , unpk_key1 == unpk_key2 -- For now we insist the literals have to agree in their encoding -- to keep the rule simple. But we could check if the decoded strings -- compare equal in here as well. , unpk_key1 `elem` [unpackCStringUtf8IdKey, unpackCStringIdKey] - , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1 - , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2 - = Just (if s1 == s2 then trueValBool else falseValBool) + , Just (LitString s1) <- exprIsLiteral_maybe env lit1 + , Just (LitString s2) <- exprIsLiteral_maybe env lit2 + = Just $ mkTicks (ticks1 ++ ticks2) + $ (if s1 == s2 then trueValBool else falseValBool) match_eq_string _ _ _ _ = Nothing |