[commit: ghc] ghc-8.6: Fix the GHCi debugger with ApplicativeDo (d170083)

[git at git.haskell.org]

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

On branch  : ghc-8.6
Link       : http://ghc.haskell.org/trac/ghc/changeset/d170083be4c8ad0ce6a3d00ce5891341fde774b8/ghc

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

commit d170083be4c8ad0ce6a3d00ce5891341fde774b8
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Sun Jul 22 17:03:33 2018 +0200

    Fix the GHCi debugger with ApplicativeDo
    
    Summary:
    `collectLStmtsBinders` was returning nothing for `ApplicativeStmts`, which
    caused the debugger to not track free variables in many cases when using
    `ApplicativeDo`.
    
    Test Plan:
    * new test case
    * validate
    
    Reviewers: bgamari, erikd
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie, carter
    
    GHC Trac Issues: #15422
    
    Differential Revision: https://phabricator.haskell.org/D4991
    
    (cherry picked from commit 4ea9311cc5c3b99ea6915bee23f0a6776731f20e)


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

d170083be4c8ad0ce6a3d00ce5891341fde774b8
 compiler/hsSyn/HsUtils.hs                             |  6 +++++-
 testsuite/tests/ghci.debugger/scripts/all.T           |  2 ++
 testsuite/tests/ghci.debugger/scripts/break029.hs     |  6 ++++++
 testsuite/tests/ghci.debugger/scripts/break029.script |  5 +++++
 testsuite/tests/ghci.debugger/scripts/break029.stdout | 10 ++++++++++
 5 files changed, 28 insertions(+), 1 deletion(-)

diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index a759f1a..eba21cf 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -1035,7 +1035,11 @@ collectStmtBinders (ParStmt _ xs _ _)      = collectLStmtsBinders
                                     $ [s | ParStmtBlock _ ss _ _ <- xs, s <- ss]
 collectStmtBinders (TransStmt { trS_stmts = stmts }) = collectLStmtsBinders stmts
 collectStmtBinders (RecStmt { recS_stmts = ss })     = collectLStmtsBinders ss
-collectStmtBinders ApplicativeStmt{} = []
+collectStmtBinders (ApplicativeStmt _ args _) = concatMap collectArgBinders args
+ where
+  collectArgBinders (_, ApplicativeArgOne _ pat _ _) = collectPatBinders pat
+  collectArgBinders (_, ApplicativeArgMany _ _ _ pat) = collectPatBinders pat
+  collectArgBinders _ = []
 collectStmtBinders XStmtLR{} = panic "collectStmtBinders"
 
 
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index f2e2658..dd122ca 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -99,3 +99,5 @@ test('T8557', normal, ghci_script, ['T8557.script'])
 test('T12458', normal, ghci_script, ['T12458.script'])
 test('T13825-debugger', when(arch('powerpc64'), expect_broken(14455)),
       ghci_script, ['T13825-debugger.script'])
+
+test('break029', extra_files(['break029.hs']), ghci_script, ['break029.script'])
diff --git a/testsuite/tests/ghci.debugger/scripts/break029.hs b/testsuite/tests/ghci.debugger/scripts/break029.hs
new file mode 100644
index 0000000..7598d3f
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/break029.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE ApplicativeDo #-}
+
+f :: Int -> IO Int
+f x = do
+  y <- return (x + 1)
+  return (y * 2)
diff --git a/testsuite/tests/ghci.debugger/scripts/break029.script b/testsuite/tests/ghci.debugger/scripts/break029.script
new file mode 100644
index 0000000..b2e70b1
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/break029.script
@@ -0,0 +1,5 @@
+:load break029.hs
+:step f 3
+:step
+:step
+y
diff --git a/testsuite/tests/ghci.debugger/scripts/break029.stdout b/testsuite/tests/ghci.debugger/scripts/break029.stdout
new file mode 100644
index 0000000..c1d7047
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/break029.stdout
@@ -0,0 +1,10 @@
+Stopped in Main.f, break029.hs:(4,7)-(6,16)
+_result :: IO Int = _
+x :: Int = 3
+Stopped in Main.f, break029.hs:5:8-21
+_result :: IO Int = _
+x :: Int = 3
+Stopped in Main.f, break029.hs:6:11-15
+_result :: Int = _
+y :: Int = _
+4