Improve the very simple optimiser slightly
authorSimon Peyton Jones <simonpj@microsoft.com>
Mon, 18 Feb 2019 13:46:35 +0000 (13:46 +0000)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Wed, 20 Feb 2019 15:17:34 +0000 (10:17 -0500)
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.

compiler/coreSyn/CoreOpt.hs
testsuite/tests/deSugar/should_compile/Makefile
testsuite/tests/deSugar/should_compile/T13208.hs [new file with mode: 0644]
testsuite/tests/deSugar/should_compile/T13208.stdout [new file with mode: 0644]
testsuite/tests/deSugar/should_compile/all.T

index 548b5de..a2ac7b5 100644 (file)
@@ -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
 
index 4600070..98e9213 100644 (file)
@@ -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 (file)
index 0000000..30af974
--- /dev/null
@@ -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 (file)
index 0000000..2917ddd
--- /dev/null
@@ -0,0 +1 @@
+f = \ (@ p) _ [Occ=Dead] -> GHC.Types.True
index 6186df0..3879341 100644 (file)
@@ -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'])