[Git][ghc/ghc][master] Flatten nested casts in the simple optimizer

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
b465dd45 by Alexis King at 2020-05-03T04:42:12-04:00
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

- - - - -


4 changed files:

- compiler/GHC/Core/SimpleOpt.hs
- + testsuite/tests/deSugar/should_compile/T18112.hs
- testsuite/tests/deSugar/should_compile/all.T
- testsuite/tests/dependent/should_compile/dynamic-paper.stderr


Changes:

=====================================
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


=====================================
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


=====================================
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'])


=====================================
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



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b465dd4500beffe919e8b8dcd075008399fbf446

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b465dd4500beffe919e8b8dcd075008399fbf446
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200503/812d5a7f/attachment-0001.html>