[Git][ghc/ghc][wip/T23916] Remove mkHsLamCasePV

[Alan Zimmerman (@alanz)]

Alan Zimmerman pushed to branch wip/T23916 at Glasgow Haskell Compiler / GHC


Commits:
4e6a272a by Alan Zimmerman at 2023-09-27T23:36:43+01:00
Remove mkHsLamCasePV

- - - - -


2 changed files:

- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs


Changes:

=====================================
compiler/GHC/Parser.y
=====================================
@@ -2871,7 +2871,7 @@ aexp    :: { ECP }
         | '\\' apats '->' exp
                    {  ECP $
                       unECP $4 >>= \ $4 ->
-                      mkHsLamPV (comb2 $1 $>)
+                      mkHsLamPV (comb2 $1 $>) LamSingle
                             (sLLl $1 $>
                             [sLLa $1 $>
                                          $ Match { m_ext = EpAnn (glR $1) [] emptyComments
@@ -2881,10 +2881,10 @@ aexp    :: { ECP }
                             [mj AnnLam $1] }
         | '\\' 'lcase' altslist(pats1)
             {  ECP $ $3 >>= \ $3 ->
-                 mkHsLamCasePV (comb2 $1 $>) LamCase $3 [mj AnnLam $1,mj AnnCase $2] }
+                 mkHsLamPV (comb2 $1 $>) LamCase $3 [mj AnnLam $1,mj AnnCase $2] }
         | '\\' 'lcases' altslist(apats)
             {  ECP $ $3 >>= \ $3 ->
-                 mkHsLamCasePV (comb2 $1 $>) LamCases $3 [mj AnnLam $1,mj AnnCases $2] }
+                 mkHsLamPV (comb2 $1 $>) LamCases $3 [mj AnnLam $1,mj AnnCases $2] }
         | 'if' exp optSemi 'then' exp optSemi 'else' exp
                          {% runPV (unECP $2) >>= \ ($2 :: LHsExpr GhcPs) ->
                             return $ ECP $


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1576,14 +1576,10 @@ 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
+  -- | Disambiguate "\... -> ..." (lambda), "\case" and "\cases"
+  mkHsLamPV :: SrcSpan -> HsLamVariant
             -> (LocatedL [LMatch GhcPs (LocatedA b)]) -> [AddEpAnn]
             -> PV (LocatedA b)
-  -- | Disambiguate "\case" and "\cases"
-  mkHsLamCasePV :: SrcSpan -> HsLamVariant
-                -> (LocatedL [LMatch GhcPs (LocatedA b)]) -> [AddEpAnn]
-                -> PV (LocatedA b)
   -- | Function argument representation
   type FunArg b
   -- | Bring superclass constraints on FunArg into scope.
@@ -1708,12 +1704,7 @@ instance DisambECP (HsCmd GhcPs) where
   ecpFromExp' (L l e) = cmdFail (locA l) (ppr e)
   mkHsProjUpdatePV l _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l $
                                                  PsErrOverloadedRecordDotInvalid
-  mkHsLamPV l (L lm m) anns = do
-    cs <- getCommentsFor l
-    let mg = mkLamCaseMatchGroup FromSource LamSingle (L lm m)
-    return $ L (noAnnSrcSpan l) (HsCmdLam (EpAnn (spanAsAnchor l) anns cs) LamSingle mg)
-
-  mkHsLamCasePV l lam_variant (L lm m) anns = do
+  mkHsLamPV l lam_variant (L lm m) anns = do
     cs <- getCommentsFor l
     let mg = mkLamCaseMatchGroup FromSource lam_variant (L lm m)
     return $ L (noAnnSrcSpan l) (HsCmdLam (EpAnn (spanAsAnchor l) anns cs) lam_variant mg)
@@ -1788,10 +1779,10 @@ instance DisambECP (HsCmd GhcPs) where
 cmdFail :: SrcSpan -> SDoc -> PV a
 cmdFail loc e = addFatalError $ mkPlainErrorMsgEnvelope loc $ PsErrParseErrorInCmd e
 
-checkLamMatchGroup :: SrcSpan -> MatchGroup GhcPs (LHsExpr GhcPs) -> PV ()
-checkLamMatchGroup l (MG { mg_alts = (L _ (matches:_))}) = do
+checkLamMatchGroup :: SrcSpan -> HsLamVariant -> MatchGroup GhcPs (LHsExpr GhcPs) -> PV ()
+checkLamMatchGroup l LamSingle (MG { mg_alts = (L _ (matches:_))}) = do
   when (null (hsLMatchPats matches)) $ addError $ mkPlainErrorMsgEnvelope l PsErrEmptyLambda
-checkLamMatchGroup _ _ = return ()
+checkLamMatchGroup _ _ _ = return ()
 
 instance DisambECP (HsExpr GhcPs) where
   type Body (HsExpr GhcPs) = HsExpr
@@ -1814,14 +1805,10 @@ 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 (L lm m) anns = do
-    cs <- getCommentsFor l
-    let mg = mkLamCaseMatchGroup FromSource LamSingle (L lm m)
-    checkLamMatchGroup l mg
-    return $ L (noAnnSrcSpan l) (HsLam (EpAnn (spanAsAnchor l) anns cs) LamSingle mg)
-  mkHsLamCasePV l lam_variant (L lm m) anns = do
+  mkHsLamPV l lam_variant (L lm m) anns = do
     cs <- getCommentsFor l
     let mg = mkLamCaseMatchGroup FromSource lam_variant (L lm m)
+    checkLamMatchGroup l lam_variant mg
     return $ L (noAnnSrcSpan l) (HsLam (EpAnn (spanAsAnchor l) anns cs) lam_variant mg)
   type FunArg (HsExpr GhcPs) = HsExpr GhcPs
   superFunArg m = m
@@ -1905,8 +1892,7 @@ instance DisambECP (PatBuilder GhcPs) where
     let anns = EpAnn (spanAsAnchor l) [] cs
     return $ L (noAnnSrcSpan l) $ PatBuilderOpApp p1 op p2 anns
 
-  mkHsLamPV l _ _                 = addFatalError $ mkPlainErrorMsgEnvelope l (PsErrLambdaInPat LamSingle)
-  mkHsLamCasePV l lam_variant _ _ = addFatalError $ mkPlainErrorMsgEnvelope l (PsErrLambdaInPat lam_variant)
+  mkHsLamPV l lam_variant _ _     = addFatalError $ mkPlainErrorMsgEnvelope l (PsErrLambdaInPat lam_variant)
 
   mkHsCasePV l _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrCaseInPat
   type FunArg (PatBuilder GhcPs) = PatBuilder GhcPs



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4e6a272aca051ecc413e4f64faa55bde67f79598

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4e6a272aca051ecc413e4f64faa55bde67f79598
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230927/b0c957f3/attachment-0001.html>