[commit: ghc] wip/dwarf-bindists, wip/pare-down-ci, wip/std-hdr-llf, wip/test-hadrian-caching, wip/validate-ci, wip/zip7-fusion: Improve the very simple optimiser slightly (5eeefe4)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branches: wip/dwarf-bindists,wip/pare-down-ci,wip/std-hdr-llf,wip/test-hadrian-caching,wip/validate-ci,wip/zip7-fusion
Link       : http://ghc.haskell.org/trac/ghc/changeset/5eeefe4c1e007ea2098f241634b48a4dada785a5/ghc

>---------------------------------------------------------------

commit 5eeefe4c1e007ea2098f241634b48a4dada785a5
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon Feb 18 13:46:35 2019 +0000

    Improve the very simple optimiser slightly
    
    There was a missing case in the very simple optimiser,
    CoreOpt.simpleOptExpr, which led to Trac #13208 comment:2.
    
    In particular, in simple_app, if we find a Let, we should
    just float it outwards. Otherwise we leave behind some
    easy-to-reduce beta-redexes.


>---------------------------------------------------------------

5eeefe4c1e007ea2098f241634b48a4dada785a5
 compiler/coreSyn/CoreOpt.hs                          | 10 ++++++++++
 testsuite/tests/deSugar/should_compile/Makefile      |  6 ++++++
 testsuite/tests/deSugar/should_compile/T13208.hs     |  3 +++
 testsuite/tests/deSugar/should_compile/T13208.stdout |  1 +
 testsuite/tests/deSugar/should_compile/all.T         |  1 +
 5 files changed, 21 insertions(+)

diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs
index 548b5de..a2ac7b5 100644
--- a/compiler/coreSyn/CoreOpt.hs
+++ b/compiler/coreSyn/CoreOpt.hs
@@ -308,6 +308,16 @@ simple_app env (Tick t e) as
   | t `tickishScopesLike` SoftScope
   = mkTick t $ simple_app env e as
 
+-- (let x = e in b) a1 .. an  =>  let x = e in (b a1 .. an)
+-- The let might appear there as a result of inlining
+-- e.g.   let f = let x = e in b
+--        in f a1 a2
+-- (Trac #13208)
+simple_app env (Let bind body) as
+  = case simple_opt_bind env bind of
+      (env', Nothing)   -> simple_app env' body as
+      (env', Just bind) -> Let bind (simple_app env' body as)
+
 simple_app env e as
   = finish_app env (simple_opt_expr env e) as
 
diff --git a/testsuite/tests/deSugar/should_compile/Makefile b/testsuite/tests/deSugar/should_compile/Makefile
index 4600070..98e9213 100644
--- a/testsuite/tests/deSugar/should_compile/Makefile
+++ b/testsuite/tests/deSugar/should_compile/Makefile
@@ -2,6 +2,12 @@ TOP=../../..
 include $(TOP)/mk/boilerplate.mk
 include $(TOP)/mk/test.mk
 
+# Should show that function f has been optimised by
+# the simple CoreOpt optimiser run by the desugarer
+T13208:
+	$(RM) -f T13028.hi T13208.o
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c T13208.hs -ddump-ds -dsuppress-uniques | grep True
+
 T5252:
 	$(RM) -f T5252.hi  T5252.o
 	$(RM) -f T5252a.hi T5252a.o
diff --git a/testsuite/tests/deSugar/should_compile/T13208.hs b/testsuite/tests/deSugar/should_compile/T13208.hs
new file mode 100644
index 0000000..30af974
--- /dev/null
+++ b/testsuite/tests/deSugar/should_compile/T13208.hs
@@ -0,0 +1,3 @@
+module T13208 where
+
+f x = let g = \x -> x in g True
diff --git a/testsuite/tests/deSugar/should_compile/T13208.stdout b/testsuite/tests/deSugar/should_compile/T13208.stdout
new file mode 100644
index 0000000..2917ddd
--- /dev/null
+++ b/testsuite/tests/deSugar/should_compile/T13208.stdout
@@ -0,0 +1 @@
+f = \ (@ p) _ [Occ=Dead] -> GHC.Types.True
diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T
index 6186df0..3879341 100644
--- a/testsuite/tests/deSugar/should_compile/all.T
+++ b/testsuite/tests/deSugar/should_compile/all.T
@@ -106,3 +106,4 @@ test('T14547', normal, compile, ['-Wincomplete-patterns'])
 test('T14773a', normal, compile, ['-Wincomplete-patterns'])
 test('T14773b', normal, compile, ['-Wincomplete-patterns'])
 test('T14815', [], makefile_test, ['T14815'])
+test('T13208', [], makefile_test, ['T13208'])