[commit: ghc] wip/inlining-late: Disable binder swap in OccurAnal (Trac #16288) (139d4cd)

[git at git.haskell.org]

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

On branch  : wip/inlining-late
Link       : http://ghc.haskell.org/trac/ghc/changeset/139d4cd1815a979fe7b86cc7dd25036cb6787b80/ghc

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

commit 139d4cd1815a979fe7b86cc7dd25036cb6787b80
Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io>
Date:   Fri Feb 8 17:49:28 2019 +0100

    Disable binder swap in OccurAnal (Trac #16288)


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

139d4cd1815a979fe7b86cc7dd25036cb6787b80
 compiler/coreSyn/CoreUnfold.hs                          | 10 +++++-----
 .../tests/dependent/should_compile/dynamic-paper.stderr |  4 ++--
 testsuite/tests/simplCore/should_compile/T16288A.hs     | 17 +++++++++++++++++
 testsuite/tests/simplCore/should_compile/T16288B.hs     |  7 +++++++
 testsuite/tests/simplCore/should_compile/T16288C.hs     | 13 +++++++++++++
 testsuite/tests/simplCore/should_compile/all.T          |  1 +
 6 files changed, 45 insertions(+), 7 deletions(-)

diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs
index 11c2a75..9b97e95 100644
--- a/compiler/coreSyn/CoreUnfold.hs
+++ b/compiler/coreSyn/CoreUnfold.hs
@@ -47,7 +47,7 @@ import GhcPrelude
 import DynFlags
 import CoreSyn
 import PprCore          ()      -- Instances
-import OccurAnal        ( occurAnalyseExpr )
+import OccurAnal        ( occurAnalyseExpr_NoBinderSwap )
 import CoreOpt
 import CoreArity       ( manifestArity )
 import CoreUtils
@@ -101,7 +101,7 @@ mkDFunUnfolding :: [Var] -> DataCon -> [CoreExpr] -> Unfolding
 mkDFunUnfolding bndrs con ops
   = DFunUnfolding { df_bndrs = bndrs
                   , df_con = con
-                  , df_args = map occurAnalyseExpr ops }
+                  , df_args = map occurAnalyseExpr_NoBinderSwap ops } -- see Trac #16288
                   -- See Note [Occurrence analysis of unfoldings]
 
 mkWwInlineRule :: DynFlags -> CoreExpr -> Arity -> Unfolding
@@ -311,7 +311,7 @@ mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr
                 -> UnfoldingGuidance -> Unfolding
 -- Occurrence-analyses the expression before capturing it
 mkCoreUnfolding src top_lvl expr guidance
-  = CoreUnfolding { uf_tmpl         = occurAnalyseExpr expr,
+  = CoreUnfolding { uf_tmpl         = occurAnalyseExpr_NoBinderSwap expr, -- see Trac #16288
                       -- See Note [Occurrence analysis of unfoldings]
                     uf_src          = src,
                     uf_is_top       = top_lvl,
@@ -330,7 +330,7 @@ mkUnfolding :: DynFlags -> UnfoldingSource
 -- Calculates unfolding guidance
 -- Occurrence-analyses the expression before capturing it
 mkUnfolding dflags src is_top_lvl is_bottoming expr
-  = CoreUnfolding { uf_tmpl         = occurAnalyseExpr expr,
+  = CoreUnfolding { uf_tmpl         = occurAnalyseExpr_NoBinderSwap expr, -- see Trac #16288
                       -- See Note [Occurrence analysis of unfoldings]
                     uf_src          = src,
                     uf_is_top       = is_top_lvl,
@@ -342,7 +342,7 @@ mkUnfolding dflags src is_top_lvl is_bottoming expr
   where
     is_top_bottoming = is_top_lvl && is_bottoming
     guidance         = calcUnfoldingGuidance dflags is_top_bottoming expr
-        -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr expr))!
+        -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr_NoBinderSwap expr))!
         -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression]
 
 {-
diff --git a/testsuite/tests/dependent/should_compile/dynamic-paper.stderr b/testsuite/tests/dependent/should_compile/dynamic-paper.stderr
index 3ba4db2..a170d29 100644
--- a/testsuite/tests/dependent/should_compile/dynamic-paper.stderr
+++ b/testsuite/tests/dependent/should_compile/dynamic-paper.stderr
@@ -1,5 +1,5 @@
 Simplifier ticks exhausted
-  When trying UnfoldingDone delta1
+  When trying UnfoldingDone delta
   To increase the limit, use -fsimpl-tick-factor=N (default 100).
    
   If you need to increase the limit substantially, please file a
@@ -12,4 +12,4 @@ Simplifier ticks exhausted
   simplifier non-termination has been judged acceptable.
    
   To see detailed counts use -ddump-simpl-stats
-  Total ticks: 140004
+  Total ticks: 140007
diff --git a/testsuite/tests/simplCore/should_compile/T16288A.hs b/testsuite/tests/simplCore/should_compile/T16288A.hs
new file mode 100644
index 0000000..c6a52bf
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T16288A.hs
@@ -0,0 +1,17 @@
+module T16288A where
+
+import T16288C
+
+data License
+
+class Pretty a where
+  pretty :: a -> Doc
+
+instance Pretty License where
+  pretty _  = pretV
+
+bar :: (Pretty a) => a -> Doc
+bar w = foo (pretty (u w w w w))
+
+u :: a -> a -> a -> a -> a
+u = u
diff --git a/testsuite/tests/simplCore/should_compile/T16288B.hs b/testsuite/tests/simplCore/should_compile/T16288B.hs
new file mode 100644
index 0000000..c1a98d2
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T16288B.hs
@@ -0,0 +1,7 @@
+module T16288B where
+
+import T16288A
+import T16288C
+
+bar2 :: License -> Doc
+bar2 = bar
diff --git a/testsuite/tests/simplCore/should_compile/T16288C.hs b/testsuite/tests/simplCore/should_compile/T16288C.hs
new file mode 100644
index 0000000..5efbb2e
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T16288C.hs
@@ -0,0 +1,13 @@
+module T16288C where
+
+data Doc = Empty | Beside Doc
+
+hcat :: Doc -> Doc
+hcat Empty = Empty
+hcat xs = hcat xs
+
+pretV = hcat Empty
+
+foo :: Doc -> Doc
+foo Empty = hcat Empty
+foo val = Beside val
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 06b5e48..779b091 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -299,3 +299,4 @@ test('T15631',
      normal,
      makefile_test, ['T15631'])
 test('T15673', normal, compile, ['-O'])
+test('T16288', normal, multimod_compile, ['T16288B', '-O -dcore-lint -v0'])