[commit: ghc] ghc-8.0: Always do eta-reduction (392b9d7)

[git at git.haskell.org]

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

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/392b9d7a866c74935e7c740c84c61802148fb6c8/ghc

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

commit 392b9d7a866c74935e7c740c84c61802148fb6c8
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Feb 11 10:38:33 2016 +0000

    Always do eta-reduction
    
    See Note [Eta-reduction in -O0] in DynFlags.
    
    Bottom line: doing eta reduction unconditionally is benign, and
    removes an ASSERT failure (Trac #11562).
    
    (cherry picked from commit 850085555a1103810d57f0d9835f4d525fd8ec00)


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

392b9d7a866c74935e7c740c84c61802148fb6c8
 compiler/main/DynFlags.hs                          | 17 ++++++++++-
 testsuite/tests/simplCore/should_compile/T11562.hs | 35 ++++++++++++++++++++++
 testsuite/tests/simplCore/should_compile/all.T     |  1 +
 3 files changed, 52 insertions(+), 1 deletion(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 327cb97..959a68d 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -3723,6 +3723,7 @@ impliedXFlags
 optLevelFlags :: [([Int], GeneralFlag)]
 optLevelFlags -- see Note [Documenting optimisation flags]
   = [ ([0,1,2], Opt_DoLambdaEtaExpansion)
+    , ([0,1,2], Opt_DoEtaReduction)       -- See Note [Eta-reduction in -O0]
     , ([0,1,2], Opt_DmdTxDictSel)
     , ([0,1,2], Opt_LlvmTBAA)
     , ([0,1,2], Opt_VectorisationAvoidance)
@@ -3739,7 +3740,6 @@ optLevelFlags -- see Note [Documenting optimisation flags]
     , ([1,2],   Opt_CmmElimCommonBlocks)
     , ([1,2],   Opt_CmmSink)
     , ([1,2],   Opt_CSE)
-    , ([1,2],   Opt_DoEtaReduction)
     , ([1,2],   Opt_EnableRewriteRules)  -- Off for -O0; see Note [Scoping for Builtin rules]
                                          --              in PrelRules
     , ([1,2],   Opt_FloatIn)
@@ -3761,6 +3761,21 @@ optLevelFlags -- see Note [Documenting optimisation flags]
 --   Static Argument Transformation needs investigation. See #9374
     ]
 
+{- Note [Eta-reduction in -O0]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Trac #11562 showed an example which tripped an ASSERT in CoreToStg; a
+function was marked as MayHaveCafRefs when in fact it obviously
+didn't.  Reason was:
+ * Eta reduction wasn't happening in the simplifier, but it was
+   happening in CorePrep, on
+        $fBla = MkDict (/\a. K a)
+ * Result: rhsIsStatic told TidyPgm that $fBla might have CAF refs
+   but the eta-reduced version (MkDict K) obviously doesn't
+Simple solution: just let the simplifier do eta-reduction even in -O0.
+After all, CorePrep does it unconditionally!  Not a big deal, but
+removes an assertion failure. -}
+
+
 -- -----------------------------------------------------------------------------
 -- Standard sets of warning options
 
diff --git a/testsuite/tests/simplCore/should_compile/T11562.hs b/testsuite/tests/simplCore/should_compile/T11562.hs
new file mode 100644
index 0000000..873e1af
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T11562.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- Trac #11562 reported an ASSERT error
+-- It only showed up /without/ -O, and obviously
+-- with a compiler built with -DDEBUG
+
+module T11562 where
+import qualified GHC.Types as C (Constraint)
+
+class Category (cat :: k -> k -> *) where
+  id :: cat a a
+  (.) :: cat b c -> cat a b -> cat a c
+
+data Dict :: C.Constraint -> * where
+  Dict :: a => Dict a
+
+newtype C2D a b = Sub (a => Dict b)
+
+instance Category C2D where
+  id  = Sub Dict
+  f . g = Sub (sub (sub Dict f) g)
+
+sub :: a => (b => r) -> (C2D a b) -> r
+sub r (Sub Dict) = r
+
+{-
+$ inplace/bin/ghc-stage2 -fforce-recomp -c C.hs -O0
+
+WARNING: file compiler/stgSyn/CoreToStg.hs, line 250
+  $fCategoryConstraint:- True False
+-}
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 0050bee..225b524 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -229,4 +229,5 @@ test('T11155',
      run_command,
      ['$MAKE -s --no-print-directory T11155'])
 test('T11232', normal, compile, ['-O2'])
+test('T11562', normal, compile, ['-O2'])
 test('T11644', normal, compile, ['-O2'])