diff options
| author | Alexis King <lexi.lambda@gmail.com> | 2020-04-30 22:50:29 -0500 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-05-03 04:42:12 -0400 |
| commit | b465dd4500beffe919e8b8dcd075008399fbf446 (patch) | |
| tree | 72192f4d67e01d5d2e21414f403e1abdb8ab41fa | |
| parent | 02543d5ef9bd7a910fc9fece895780583ab9635a (diff) | |
| download | haskell-b465dd4500beffe919e8b8dcd075008399fbf446.tar.gz | |
Flatten nested casts in the simple optimizer
Normally, we aren’t supposed to generated any nested casts, since mkCast
takes care to flatten them, but the simple optimizer didn’t use mkCast,
so they could show up after inlining. This isn’t really a problem, since
the simplifier will clean them up immediately anyway, but it can clutter
the -ddump-ds output, and it’s an extremely easy fix.
closes #18112
| -rw-r--r-- | compiler/GHC/Core/SimpleOpt.hs | 11 | ||||
| -rw-r--r-- | testsuite/tests/deSugar/should_compile/T18112.hs | 14 | ||||
| -rw-r--r-- | testsuite/tests/deSugar/should_compile/all.T | 1 | ||||
| -rw-r--r-- | testsuite/tests/dependent/should_compile/dynamic-paper.stderr | 2 |
4 files changed, 23 insertions, 5 deletions
diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs index 1f3c950ffe..3e55600461 100644 --- a/compiler/GHC/Core/SimpleOpt.hs +++ b/compiler/GHC/Core/SimpleOpt.hs @@ -221,10 +221,13 @@ simple_opt_expr env expr go (Coercion co) = Coercion (optCoercion (soe_dflags env) (getTCvSubst subst) co) go (Lit lit) = Lit lit go (Tick tickish e) = mkTick (substTickish subst tickish) (go e) - go (Cast e co) | isReflCo co' = go e - | otherwise = Cast (go e) co' - where - co' = optCoercion (soe_dflags env) (getTCvSubst subst) co + go (Cast e co) = case go e of + -- flatten nested casts before calling the coercion optimizer; + -- see #18112 (note that mkCast handles dropping Refl coercions) + Cast e' co' -> mkCast e' (opt_co (mkTransCo co' co)) + e' -> mkCast e' (opt_co co) + where + opt_co = optCoercion (soe_dflags env) (getTCvSubst subst) go (Let bind body) = case simple_opt_bind env bind NotTopLevel of (env', Nothing) -> simple_opt_expr env' body diff --git a/testsuite/tests/deSugar/should_compile/T18112.hs b/testsuite/tests/deSugar/should_compile/T18112.hs new file mode 100644 index 0000000000..972bb7c0b0 --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T18112.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE TypeFamilies #-} +module T18112 where + +type family F a where + F Int = String + +-- This test is really testing the simple optimizer. We expect the +-- optimized desugared output to contain no casts, since the simple +-- optimizer should fuse the two casts together after inlining y. + +blah :: Bool -> String +blah x = let y :: F Int + y = show x + in y diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T index f72a854045..888369b849 100644 --- a/testsuite/tests/deSugar/should_compile/all.T +++ b/testsuite/tests/deSugar/should_compile/all.T @@ -109,3 +109,4 @@ test('T14773b', normal, compile, ['-Wincomplete-patterns']) test('T14815', [], makefile_test, ['T14815']) test('T13208', [], makefile_test, ['T13208']) test('T16615', normal, compile, ['-ddump-ds -dsuppress-uniques']) +test('T18112', [grep_errmsg('cast')], compile, ['-ddump-ds']) diff --git a/testsuite/tests/dependent/should_compile/dynamic-paper.stderr b/testsuite/tests/dependent/should_compile/dynamic-paper.stderr index e9d6540f14..89b88f45ab 100644 --- a/testsuite/tests/dependent/should_compile/dynamic-paper.stderr +++ b/testsuite/tests/dependent/should_compile/dynamic-paper.stderr @@ -12,4 +12,4 @@ Simplifier ticks exhausted simplifier non-termination has been judged acceptable. To see detailed counts use -ddump-simpl-stats - Total ticks: 140084 + Total ticks: 138082 |