[commit: ghc] ghc-8.2: Fix a bug in -foptimal-applicative-do (94427b1)

[git at git.haskell.org]

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

On branch  : ghc-8.2
Link       : http://ghc.haskell.org/trac/ghc/changeset/94427b13de0214ad4d944bda575c33dc8aefdd1d/ghc

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

commit 94427b13de0214ad4d944bda575c33dc8aefdd1d
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Mon Jun 12 17:00:39 2017 -0400

    Fix a bug in -foptimal-applicative-do
    
    Test Plan: validate
    
    Reviewers: bgamari, niteria, austin, erikd
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D3640
    
    (cherry picked from commit 7e0ef11324712b4ff3ac8f39259e5ecbd63c2356)


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

94427b13de0214ad4d944bda575c33dc8aefdd1d
 compiler/rename/RnExpr.hs              |  2 +-
 testsuite/tests/ado/ado-optimal.hs     | 11 +++++++++++
 testsuite/tests/ado/ado-optimal.stdout |  1 +
 3 files changed, 13 insertions(+), 1 deletion(-)

diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index 001bc46..ec3ad0b 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -1592,7 +1592,7 @@ mkStmtTreeOptimal stmts =
               (StmtTreeOne (stmt_arr ! hi), 1))
            | left_cost < right_cost
            = ((left,left_cost), (StmtTreeOne (stmt_arr ! hi), 1))
-           | otherwise -- left_cost > right_cost
+           | left_cost > right_cost
            = ((StmtTreeOne (stmt_arr ! lo), 1), (right,right_cost))
            | otherwise = minimumBy (comparing cost) alternatives
            where
diff --git a/testsuite/tests/ado/ado-optimal.hs b/testsuite/tests/ado/ado-optimal.hs
index aab8d53..d67aa4f 100644
--- a/testsuite/tests/ado/ado-optimal.hs
+++ b/testsuite/tests/ado/ado-optimal.hs
@@ -18,8 +18,19 @@ test1 = do
   x5 <- const e (x1,x4)
   return (const () x5)
 
+-- (a | c); (b | d); e
+test2 :: M ()
+test2 = do
+  x1 <- a
+  x3 <- c
+  x2 <- const b x1
+  x4 <- const d x3
+  x5 <- const e (x1,x4)
+  return (const () x5)
+
 main = mapM_ run
  [ test1
+ , test2
  ]
 
 -- Testing code, prints out the structure of a monad/applicative expression
diff --git a/testsuite/tests/ado/ado-optimal.stdout b/testsuite/tests/ado/ado-optimal.stdout
index 29f9856..1df5e57 100644
--- a/testsuite/tests/ado/ado-optimal.stdout
+++ b/testsuite/tests/ado/ado-optimal.stdout
@@ -1 +1,2 @@
 ((a; b) | (c; d)); e
+(a | c); ((b | d); e)