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.

5 files changed, 21 insertions, 0 deletions

diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs
index 548b5de269..a2ac7b5be9 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 4600070c05..98e9213bc3 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 0000000000..30af974a1e
--- /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 0000000000..2917dddfea
--- /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 6186df06e9..38793419db 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'])