fix #19736

6 files changed, 24 insertions, 6 deletions

diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 6c85b8d08c..da5572dcef 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2778,16 +2778,16 @@ aexp    :: { ECP }
                                    unECP $2 >>= \ $2 ->
                                    mkHsNegAppPV (comb2A $1 $>) $2 [mj AnnMinus $1] }
 
-        | '\\' apat apats '->' exp
+        | '\\' apats '->' exp
                    {  ECP $
-                      unECP $5 >>= \ $5 ->
+                      unECP $4 >>= \ $4 ->
                       mkHsLamPV (comb2 $1 (reLoc $>)) (\cs -> mkMatchGroup FromSource
                             (reLocA $ sLLlA $1 $>
                             [reLocA $ sLLlA $1 $>
                                          $ Match { m_ext = EpAnn (glR $1) [mj AnnLam $1] cs
                                                  , m_ctxt = LambdaExpr
-                                                 , m_pats = $2:$3
-                                                 , m_grhss = unguardedGRHSs (comb2 $4 (reLoc $5)) $5 (EpAnn (glR $4) (GrhsAnn Nothing (mu AnnRarrow $4)) emptyComments) }])) }
+                                                 , m_pats = $2
+                                                 , m_grhss = unguardedGRHSs (comb2 $3 (reLoc $4)) $4 (EpAnn (glR $3) (GrhsAnn Nothing (mu AnnRarrow $3)) emptyComments) }])) }
         | 'let' binds 'in' exp          {  ECP $
                                            unECP $4 >>= \ $4 ->
                                            mkHsLetPV (comb2A $1 $>) (unLoc $2) $4
diff --git a/compiler/GHC/Parser/Errors.hs b/compiler/GHC/Parser/Errors.hs
index 83812f7673..e48f04aae5 100644
--- a/compiler/GHC/Parser/Errors.hs
+++ b/compiler/GHC/Parser/Errors.hs
@@ -90,6 +90,9 @@ data PsErrorDesc
    = PsErrLambdaCase
       -- ^ LambdaCase syntax used without the extension enabled
 
+   | PsErrEmptyLambda
+      -- ^ A lambda requires at least one parameter
+
    | PsErrNumUnderscores !NumUnderscoreReason
       -- ^ Underscores in literals without the extension enabled
 
diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs
index 7b9f2e64a0..0e83949a2e 100644
--- a/compiler/GHC/Parser/Errors/Ppr.hs
+++ b/compiler/GHC/Parser/Errors/Ppr.hs
@@ -141,6 +141,9 @@ pp_err = \case
    PsErrLambdaCase
       -> text "Illegal lambda-case (use LambdaCase)"
 
+   PsErrEmptyLambda
+      -> text "A lambda requires at least one parameter"
+
    PsErrNumUnderscores reason
       -> text $ case reason of
             NumUnderscore_Integral -> "Use NumericUnderscores to allow underscores in integer literals"
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 1de9f0cd53..6411df34d9 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -1629,6 +1629,11 @@ instance DisambECP (HsCmd GhcPs) where
 cmdFail :: SrcSpan -> SDoc -> PV a
 cmdFail loc e = addFatalError $ PsError (PsErrParseErrorInCmd e) [] loc
 
+checkLamMatchGroup :: SrcSpan -> MatchGroup GhcPs (LHsExpr GhcPs) -> PV ()
+checkLamMatchGroup l (MG { mg_alts = (L _ (matches:_))}) = do
+  when (null (hsLMatchPats matches)) $ addError $ PsError PsErrEmptyLambda [] l
+checkLamMatchGroup _ _ = return ()
+
 instance DisambECP (HsExpr GhcPs) where
   type Body (HsExpr GhcPs) = HsExpr
   ecpFromCmd' (L l c) = do
@@ -1640,7 +1645,9 @@ instance DisambECP (HsExpr GhcPs) where
     return $ mkRdrProjUpdate (noAnnSrcSpan l) fields arg isPun (EpAnn (spanAsAnchor l) anns cs)
   mkHsLamPV l mg = do
     cs <- getCommentsFor l
-    return $ L (noAnnSrcSpan l) (HsLam NoExtField (mg cs))
+    let mg' = mg cs
+    checkLamMatchGroup l mg'
+    return $ L (noAnnSrcSpan l) (HsLam NoExtField mg')
   mkHsLetPV l bs c anns = do
     cs <- getCommentsFor l
     return $ L (noAnnSrcSpan l) (HsLet (EpAnn (spanAsAnchor l) anns cs) bs c)
diff --git a/testsuite/tests/parser/should_fail/T16270.hs b/testsuite/tests/parser/should_fail/T16270.hs
index 4967eeb5ce..d053b98f60 100644
--- a/testsuite/tests/parser/should_fail/T16270.hs
+++ b/testsuite/tests/parser/should_fail/T16270.hs
@@ -37,6 +37,8 @@ n = 123_456
 
 s = "hello ωorld"#   -- note the omega
 
+lam = \ -> 0
+
 -- a fatal error.
 k = let
 
diff --git a/testsuite/tests/parser/should_fail/T16270.stderr b/testsuite/tests/parser/should_fail/T16270.stderr
index 5bb5bea99b..6666ac7963 100644
--- a/testsuite/tests/parser/should_fail/T16270.stderr
+++ b/testsuite/tests/parser/should_fail/T16270.stderr
@@ -64,5 +64,8 @@ T16270.hs:36:5: error:
 T16270.hs:38:5: error:
     primitive string literal must contain only characters <= '\xFF'
 
-T16270.hs:44:1: error:
+T16270.hs:40:7: error:
+    A lambda requires at least one parameter
+
+T16270.hs:46:1: error:
     parse error (possibly incorrect indentation or mismatched brackets)