diff options
| -rw-r--r-- | compiler/GHC/Core/Opt/ConstantFold.hs | 14 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/T16373.hs | 13 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/T16373.stderr | 13 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/all.T | 1 |
4 files changed, 35 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 diff --git a/testsuite/tests/simplCore/should_compile/T16373.hs b/testsuite/tests/simplCore/should_compile/T16373.hs new file mode 100644 index 0000000000..e8346ca30a --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T16373.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE DataKinds #-} +{-# OPTIONS_GHC -ddump-simpl -dsuppress-all -dno-typeable-binds -O2 #-} + +module Test2 where + +import GHC.TypeLits +import Data.Proxy + +testAA :: Bool +testAA = symbolVal (Proxy :: Proxy "A") == symbolVal (Proxy :: Proxy "A") + +testAB :: Bool +testAB = symbolVal (Proxy :: Proxy "A") == symbolVal (Proxy :: Proxy "B") diff --git a/testsuite/tests/simplCore/should_compile/T16373.stderr b/testsuite/tests/simplCore/should_compile/T16373.stderr new file mode 100644 index 0000000000..0fe8484609 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T16373.stderr @@ -0,0 +1,13 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 4, types: 2, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +testAB = False + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +testAA = True + + + diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index dbec3b3066..25296eda0f 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -370,3 +370,4 @@ test('T19890', [ grep_errmsg(r'= T19890.foo1') ], compile, ['-O -ddump-simpl']) test('T20125', [ grep_errmsg(r'= T20125.MkT') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('T20143', [ grep_errmsg(r'unsafeEqualityProof') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('T20174', normal, compile, ['']) +test('T16373', normal, compile, ['']) |