[commit: ghc] ghc-8.4: Slighly improve infix con app pattern errors (161467c)

[git at git.haskell.org]

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

On branch  : ghc-8.4
Link       : http://ghc.haskell.org/trac/ghc/changeset/161467c13eee5e5aadd6595be232587f8d52293a/ghc

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

commit 161467c13eee5e5aadd6595be232587f8d52293a
Author: Ömer Sinan Ağacan <omeragacan at gmail.com>
Date:   Wed Mar 14 09:16:51 2018 +0300

    Slighly improve infix con app pattern errors
    
    Given this program:
    
        main = do
          f $ do
            a <- return 3
              c <- do
              return 5
    
    GHC previously gave this error message:
    
        Main.hs:2:7: error:
            Parse error in pattern: do a <- return 3 c
            Possibly caused by a missing 'do'?
          |
        2 |   f $ do
          |       ^^...
    
    What happened is GHC considered the whole `f $ do a <- return 3 c` as a
    pattern. When parsed as an expression it becomes an infix application of
    `($)`, and GHC checks left and right hand sides before checking if `($)`
    is a valid infix constructor name, and shows the first error it got.
    
    If instead we first check if the infix op is valid in pattern context,
    the error message becomes much clearer:
    
        Main.hs:2:3: error:
            Parse error in pattern: f $ do a <- return 3 c
            Possibly caused by a missing 'do'?
          |
        2 |   f $ do
          |   ^^^^^^...
    
    This may not entirely fix #11188 but I think it's an improvement.
    
    Reviewers: bgamari
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie, carter
    
    GHC Trac Issues: #11188
    
    Differential Revision: https://phabricator.haskell.org/D4497
    
    (cherry picked from commit cb6d8589c83247ec96d5faa82df3e93f419bbfe0)


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

161467c13eee5e5aadd6595be232587f8d52293a
 compiler/parser/RdrHsSyn.hs                              | 13 +++++++------
 testsuite/tests/parser/should_fail/InfixAppPatErr.hs     |  5 +++++
 testsuite/tests/parser/should_fail/InfixAppPatErr.stderr |  4 ++++
 testsuite/tests/parser/should_fail/all.T                 |  1 +
 4 files changed, 17 insertions(+), 6 deletions(-)

diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 126e92e..119c5c6 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -875,12 +875,13 @@ checkAPat msg loc e0 = do
                       | extopt LangExt.NPlusKPatterns opts && (plus == plus_RDR)
                       -> return (mkNPlusKPat (L nloc n) (L lloc lit))
 
-   OpApp l op _fix r  -> do l <- checkLPat msg l
-                            r <- checkLPat msg r
-                            case op of
-                               L cl (HsVar (L _ c)) | isDataOcc (rdrNameOcc c)
-                                      -> return (ConPatIn (L cl c) (InfixCon l r))
-                               _ -> patFail msg loc e0
+   OpApp l (L cl (HsVar (L _ c))) _fix r
+     | isDataOcc (rdrNameOcc c) -> do
+         l <- checkLPat msg l
+         r <- checkLPat msg r
+         return (ConPatIn (L cl c) (InfixCon l r))
+
+   OpApp _l _op _fix _r -> patFail msg loc e0
 
    HsPar e            -> checkLPat msg e >>= (return . ParPat)
    ExplicitList _ _ es  -> do ps <- mapM (checkLPat msg) es
diff --git a/testsuite/tests/parser/should_fail/InfixAppPatErr.hs b/testsuite/tests/parser/should_fail/InfixAppPatErr.hs
new file mode 100644
index 0000000..5a56f71
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/InfixAppPatErr.hs
@@ -0,0 +1,5 @@
+main = do
+  f $ do
+    a <- return 3
+      c <- do
+      return 5
diff --git a/testsuite/tests/parser/should_fail/InfixAppPatErr.stderr b/testsuite/tests/parser/should_fail/InfixAppPatErr.stderr
new file mode 100644
index 0000000..69839e3
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/InfixAppPatErr.stderr
@@ -0,0 +1,4 @@
+
+InfixAppPatErr.hs:2:3: error:
+    Parse error in pattern: f $ do a <- return 3 c
+    Possibly caused by a missing 'do'?
diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T
index abe3da9..503cab3 100644
--- a/testsuite/tests/parser/should_fail/all.T
+++ b/testsuite/tests/parser/should_fail/all.T
@@ -102,3 +102,4 @@ test('T8501a', normal, compile_fail, [''])
 test('T8501b', normal, compile_fail, [''])
 test('T8501c', normal, compile_fail, [''])
 test('T12610', normal, compile_fail, [''])
+test('InfixAppPatErr', normal, compile_fail, [''])