[commit: ghc] master: Case-of-empty-alts is trivial (Trac #11155) (1c9fd3f)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/1c9fd3f1c5522372fcaf250c805b959e8090a62c/ghc

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

commit 1c9fd3f1c5522372fcaf250c805b959e8090a62c
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Dec 3 12:57:54 2015 +0000

    Case-of-empty-alts is trivial (Trac #11155)
    
    As you'll see from Trac #11155, the code generator was confused
    by a binding let x = y in ....   Why did that happen? Because of
    a (case y of {}) expression on the RHS.
    
    The right thing is just to expand what a "trivial" expression is.
    
    See Note [Empty case is trivial] in CoreUtils.


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

1c9fd3f1c5522372fcaf250c805b959e8090a62c
 compiler/coreSyn/CorePrep.hs                       | 20 +++++++++++---------
 compiler/coreSyn/CoreUtils.hs                      | 20 +++++++++++++++++++-
 testsuite/tests/simplCore/should_compile/Makefile  |  6 ++++++
 testsuite/tests/simplCore/should_compile/T11155.hs | 11 +++++++++++
 testsuite/tests/simplCore/should_compile/all.T     |  5 ++++-
 5 files changed, 51 insertions(+), 11 deletions(-)

diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs
index fdf25d6..999ca54 100644
--- a/compiler/coreSyn/CorePrep.hs
+++ b/compiler/coreSyn/CorePrep.hs
@@ -847,15 +847,17 @@ of the scope of a `seq`, or dropped the `seq` altogether.
 
 cpe_ExprIsTrivial :: CoreExpr -> Bool
 -- Version that doesn't consider an scc annotation to be trivial.
-cpe_ExprIsTrivial (Var _)        = True
-cpe_ExprIsTrivial (Type _)       = True
-cpe_ExprIsTrivial (Coercion _)   = True
-cpe_ExprIsTrivial (Lit _)        = True
-cpe_ExprIsTrivial (App e arg)    = isTypeArg arg && cpe_ExprIsTrivial e
-cpe_ExprIsTrivial (Tick t e)     = not (tickishIsCode t) && cpe_ExprIsTrivial e
-cpe_ExprIsTrivial (Cast e _)     = cpe_ExprIsTrivial e
-cpe_ExprIsTrivial (Lam b body) | isTyVar b = cpe_ExprIsTrivial body
-cpe_ExprIsTrivial _              = False
+cpe_ExprIsTrivial (Var _)         = True
+cpe_ExprIsTrivial (Type _)        = True
+cpe_ExprIsTrivial (Coercion _)    = True
+cpe_ExprIsTrivial (Lit _)         = True
+cpe_ExprIsTrivial (App e arg)     = not (isRuntimeArg arg) && cpe_ExprIsTrivial e
+cpe_ExprIsTrivial (Lam b e)       = not (isRuntimeVar b) && cpe_ExprIsTrivial e
+cpe_ExprIsTrivial (Tick t e)      = not (tickishIsCode t) && cpe_ExprIsTrivial e
+cpe_ExprIsTrivial (Cast e _)      = cpe_ExprIsTrivial e
+cpe_ExprIsTrivial (Case e _ _ []) = cpe_ExprIsTrivial e
+                                    -- See Note [Empty case is trivial] in CoreUtils
+cpe_ExprIsTrivial _               = False
 
 {-
 -- -----------------------------------------------------------------------------
diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs
index 889e239..5c1c986 100644
--- a/compiler/coreSyn/CoreUtils.hs
+++ b/compiler/coreSyn/CoreUtils.hs
@@ -733,11 +733,28 @@ saturating them.
 
 Note [Tick trivial]
 ~~~~~~~~~~~~~~~~~~~
-
 Ticks are only trivial if they are pure annotations. If we treat
 "tick<n> x" as trivial, it will be inlined inside lambdas and the
 entry count will be skewed, for example.  Furthermore "scc<n> x" will
 turn into just "x" in mkTick.
+
+Note [Empty case is trivial]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The expression (case (x::Int) Bool of {}) is just a type-changing
+case used when we are sure that 'x' will not return.  See
+Note [Empty case alternatives] in CoreSyn.
+
+If the scrutinee is trivial, then so is the whole expression; and the
+CoreToSTG pass in fact drops the case expression leaving only the
+scrutinee.
+
+Having more trivial expressions is good.  Moreover, if we don't treat
+it as trivial we may land up with let-bindings like
+   let v = case x of {} in ...
+and after CoreToSTG that gives
+   let v = x in ...
+and that confuses the code generator (Trac #11155). So best to kill
+it off at source.
 -}
 
 exprIsTrivial :: CoreExpr -> Bool
@@ -750,6 +767,7 @@ exprIsTrivial (Tick t e)       = not (tickishIsCode t) && exprIsTrivial e
                                  -- See Note [Tick trivial]
 exprIsTrivial (Cast e _)       = exprIsTrivial e
 exprIsTrivial (Lam b body)     = not (isRuntimeVar b) && exprIsTrivial body
+exprIsTrivial (Case e _ _ [])  = exprIsTrivial e  -- See Note [Empty case is trivial]
 exprIsTrivial _                = False
 
 {-
diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile
index 8c6ec45..eb6d742 100644
--- a/testsuite/tests/simplCore/should_compile/Makefile
+++ b/testsuite/tests/simplCore/should_compile/Makefile
@@ -6,6 +6,12 @@ T8832:
 	$(RM) -f T8832.o T8832.hi
 	'$(TEST_HC)' $(TEST_HC_OPTS) $(T8832_WORDSIZE_OPTS) -O -c -ddump-simpl T8832.hs | grep '^[a-zA-Z0-9]\+ ='
 
+T11155:
+	$(RM) -f T11155.o T11155.hi
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c T11155.hs
+	-nm T11155.o  | grep 'stg_ap_0_upd'
+	# Expecting no output from the grep
+
 T8274:
 	$(RM) -f T8274.o T8274.hi
 	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl T8274.hs | grep '#'
diff --git a/testsuite/tests/simplCore/should_compile/T11155.hs b/testsuite/tests/simplCore/should_compile/T11155.hs
new file mode 100644
index 0000000..b57bbe9
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T11155.hs
@@ -0,0 +1,11 @@
+{-# OPTIONS_GHC -O -fno-full-laziness #-}
+module T11155 where
+
+foo :: Bool
+{-# NOINLINE foo #-}
+foo = error "rk"
+
+bar x = let t :: Char
+            t = case foo of { True -> 'v'; False -> 'y' }
+        in [t]
+
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index c99b8f2..f9388c9 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -224,4 +224,7 @@ test('T10083',
      run_command,
      ['$MAKE -s --no-print-directory T10083'])
 test('T10689', normal, compile, [''])
-test('T10689a', normal, compile, [''])
+test('T11155',
+     normal,
+     run_command,
+     ['$MAKE -s --no-print-directory T11155'])