diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 53991343336b735c3e357a9432aad97f9293b067..64247027aedcc67756ad6a9949670c185bc4d333 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2874,10 +2874,11 @@ aexp :: { ECP }
mkHsLamPV (comb2 $1 $>) (\cs -> mkMatchGroup FromSource
(sLLa $1 $>
[sLLa $1 $>
- $ Match { m_ext = EpAnn (glR $1) [mj AnnLam $1] cs
+ $ Match { m_ext = EpAnn (glR $1) [] cs
, m_ctxt = LamAlt LamSingle
, m_pats = $2
- , m_grhss = unguardedGRHSs (comb2 $3 $4) $4 (EpAnn (glR $3) (GrhsAnn Nothing (mu AnnRarrow $3)) emptyComments) }])) }
+ , m_grhss = unguardedGRHSs (comb2 $3 $4) $4 (EpAnn (glR $3) (GrhsAnn Nothing (mu AnnRarrow $3)) emptyComments) }]))
+ [mj AnnLam $1] }
| '\\' 'lcase' altslist(pats1)
{ ECP $ $3 >>= \ $3 ->
mkHsLamCasePV (comb2 $1 $>) LamCase $3 [mj AnnLam $1,mj AnnCase $2] }
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 6bd7291eb0168bba9e26f9406526e0f521fbdd35..7c0ef8e92bc9a0e78b7e0f668de4a7c17bdecf9d 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -1556,9 +1556,6 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
ecpFromExp' :: LHsExpr GhcPs -> PV (LocatedA b)
mkHsProjUpdatePV :: SrcSpan -> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
-> LocatedA b -> Bool -> [AddEpAnn] -> PV (LHsRecProj GhcPs (LocatedA b))
- -- | Disambiguate "\... -> ..." (lambda)
- mkHsLamPV
- :: SrcSpan -> (EpAnnComments -> MatchGroup GhcPs (LocatedA b)) -> PV (LocatedA b)
-- | Disambiguate "let ... in ..."
mkHsLetPV
:: SrcSpan
@@ -1579,6 +1576,9 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
-- | Disambiguate "case ... of ..."
mkHsCasePV :: SrcSpan -> LHsExpr GhcPs -> (LocatedL [LMatch GhcPs (LocatedA b)])
-> EpAnnHsCase -> PV (LocatedA b)
+ -- | Disambiguate "\... -> ..." (lambda)
+ mkHsLamPV
+ :: SrcSpan -> (EpAnnComments -> MatchGroup GhcPs (LocatedA b)) -> [AddEpAnn] -> PV (LocatedA b)
-- | Disambiguate "\case" and "\cases"
mkHsLamCasePV :: SrcSpan -> HsLamVariant
-> (LocatedL [LMatch GhcPs (LocatedA b)]) -> [AddEpAnn]
@@ -1707,9 +1707,9 @@ instance DisambECP (HsCmd GhcPs) where
ecpFromExp' (L l e) = cmdFail (locA l) (ppr e)
mkHsProjUpdatePV l _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l $
PsErrOverloadedRecordDotInvalid
- mkHsLamPV l mg = do
+ mkHsLamPV l mg anns = do
cs <- getCommentsFor l
- return $ L (noAnnSrcSpan l) (HsCmdLam (EpAnn (spanAsAnchor l) [] cs) LamSingle (mg cs))
+ return $ L (noAnnSrcSpan l) (HsCmdLam (EpAnn (spanAsAnchor l) anns cs) LamSingle (mg cs))
mkHsLamCasePV l lam_variant (L lm m) anns = do
cs <- getCommentsFor l
@@ -1800,11 +1800,6 @@ instance DisambECP (HsExpr GhcPs) where
mkHsProjUpdatePV l fields arg isPun anns = do
cs <- getCommentsFor l
return $ mkRdrProjUpdate (noAnnSrcSpan l) fields arg isPun (EpAnn (spanAsAnchor l) anns cs)
- mkHsLamPV l mg = do
- cs <- getCommentsFor l
- let mg' = mg cs
- checkLamMatchGroup l mg'
- return $ L (noAnnSrcSpan l) (HsLam (EpAnn (spanAsAnchor l) [] cs) LamSingle mg')
mkHsLetPV l tkLet bs tkIn c = do
cs <- getCommentsFor l
return $ L (noAnnSrcSpan l) (HsLet (EpAnn (spanAsAnchor l) NoEpAnns cs) tkLet bs tkIn c)
@@ -1817,6 +1812,11 @@ instance DisambECP (HsExpr GhcPs) where
cs <- getCommentsFor l
let mg = mkMatchGroup FromSource (L lm m)
return $ L (noAnnSrcSpan l) (HsCase (EpAnn (spanAsAnchor l) anns cs) e mg)
+ mkHsLamPV l mg anns = do
+ cs <- getCommentsFor l
+ let mg' = mg cs
+ checkLamMatchGroup l mg'
+ return $ L (noAnnSrcSpan l) (HsLam (EpAnn (spanAsAnchor l) anns cs) LamSingle mg')
mkHsLamCasePV l lam_variant (L lm m) anns = do
cs <- getCommentsFor l
let mg = mkLamCaseMatchGroup FromSource lam_variant (L lm m)
@@ -1894,7 +1894,6 @@ instance DisambECP (PatBuilder GhcPs) where
type Body (PatBuilder GhcPs) = PatBuilder
ecpFromCmd' (L l c) = addFatalError $ mkPlainErrorMsgEnvelope (locA l) $ PsErrArrowCmdInPat c
ecpFromExp' (L l e) = addFatalError $ mkPlainErrorMsgEnvelope (locA l) $ PsErrArrowExprInPat e
- mkHsLamPV l _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrLambdaInPat
mkHsLetPV l _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrLetInPat
mkHsProjUpdatePV l _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrOverloadedRecordDotInvalid
type InfixOp (PatBuilder GhcPs) = RdrName
@@ -1903,6 +1902,7 @@ instance DisambECP (PatBuilder GhcPs) where
cs <- getCommentsFor l
let anns = EpAnn (spanAsAnchor l) [] cs
return $ L (noAnnSrcSpan l) $ PatBuilderOpApp p1 op p2 anns
+ mkHsLamPV l _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrLambdaInPat
mkHsCasePV l _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrCaseInPat
mkHsLamCasePV l lam_variant _ _ = addFatalError $ mkPlainErrorMsgEnvelope l (PsErrLambdaCaseInPat lam_variant)
type FunArg (PatBuilder GhcPs) = PatBuilder GhcPs
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 00263bbc9ce0f0365f3b716d9db18e044e333153..5cc51fc659865b1ad753ca2ba214313cd7f0ad73 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -2762,14 +2762,12 @@ instance ExactPrint (HsExpr GhcPs) where
lit' <- withPpr lit
return (HsLit an lit')
- -- ToDo: Do these two cases need to be handled separately?
- exact (HsLam an LamSingle mg) = do
- mg' <- markAnnotated mg
- return (HsLam an LamSingle mg')
exact (HsLam an lam_variant mg) = do
an0 <- markEpAnnL an lidl AnnLam
- an1 <- markEpAnnL an0 lidl (case lam_variant of LamCase -> AnnCase
- LamCases -> AnnCases)
+ an1 <- case lam_variant of
+ LamSingle -> return an0
+ LamCase -> markEpAnnL an0 lidl AnnCase
+ LamCases -> markEpAnnL an0 lidl AnnCases
mg' <- markAnnotated mg
return (HsLam an1 lam_variant mg')
@@ -3286,14 +3284,12 @@ instance ExactPrint (HsCmd GhcPs) where
e2' <- markAnnotated e2
return (HsCmdApp an e1' e2')
- exact (HsCmdLam a LamSingle match) = do
- match' <- markAnnotated match
- return (HsCmdLam a LamSingle match')
-
exact (HsCmdLam an lam_variant matches) = do
an0 <- markEpAnnL an lidl AnnLam
- an1 <- markEpAnnL an0 lidl (case lam_variant of LamCase -> AnnCase
- LamCases -> AnnCases)
+ an1 <- case lam_variant of
+ LamSingle -> return an0
+ LamCase -> markEpAnnL an0 lidl AnnCase
+ LamCases -> markEpAnnL an0 lidl AnnCases
matches' <- markAnnotated matches
return (HsCmdLam an1 lam_variant matches')