Implement \cases (Proposal 302)

This commit implements proposal 302: \cases - Multi-way lambda
expressions.

This adds a new expression heralded by \cases, which works exactly like
\case, but can match multiple apats instead of a single pat.

Updates submodule haddock to support the ITlcases token.

Closes #20768

2 files changed, 16 insertions, 8 deletions

diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 3d493cfd22..3ea74a569c 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -12,6 +12,7 @@
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TypeApplications     #-}
 {-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE BlockArguments       #-}
 {-# LANGUAGE UndecidableInstances  #-} -- For the (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) ExactPrint instance
 
 module ExactPrint
@@ -1429,7 +1430,9 @@ instance ExactPrint (Match GhcPs (LocatedA (HsExpr GhcPs))) where
   --     LambdaExpr -> do
   --       markEpAnn an AnnLam
   --       mapM_ markAnnotated pats
-  --     GHC.CaseAlt -> do
+  --     CaseAlt -> do
+  --       mapM_ markAnnotated pats
+  --     LamCaseAlt _ ->
   --       mapM_ markAnnotated pats
   --     _ -> withPpr mctxt
 
@@ -1473,7 +1476,9 @@ exactMatch (Match an mctxt pats grhss) = do
     LambdaExpr -> do
       markEpAnn an AnnLam
       markAnnotated pats
-    GHC.CaseAlt -> do
+    CaseAlt -> do
+      markAnnotated pats
+    LamCaseAlt _ -> do
       markAnnotated pats
     _ -> withPpr mctxt
 
@@ -1832,7 +1837,7 @@ instance ExactPrint (HsExpr GhcPs) where
   getAnnotationEntry (HsOverLit an _)             = fromAnn an
   getAnnotationEntry (HsLit an _)                 = fromAnn an
   getAnnotationEntry (HsLam _ _)                  = NoEntryVal
-  getAnnotationEntry (HsLamCase an _)             = fromAnn an
+  getAnnotationEntry (HsLamCase an _ _)           = fromAnn an
   getAnnotationEntry (HsApp an _ _)               = fromAnn an
   getAnnotationEntry (HsAppType _ _ _)            = NoEntryVal
   getAnnotationEntry (OpApp an _ _ _)             = fromAnn an
@@ -1897,9 +1902,10 @@ instance ExactPrint (HsExpr GhcPs) where
       -- markExpr _ (HsLam _ _) = error $ "HsLam with other than one match"
   exact (HsLam _ _) = error $ "HsLam with other than one match"
 
-  exact (HsLamCase an mg) = do
+  exact (HsLamCase an lc_variant mg) = do
     markEpAnn an AnnLam
-    markEpAnn an AnnCase
+    markEpAnn an case lc_variant of LamCase -> AnnCase
+                                    LamCases -> AnnCases
     markAnnotated mg
 
   exact (HsApp _an e1 e2) = do
@@ -2317,7 +2323,7 @@ instance ExactPrint (HsCmd GhcPs) where
   getAnnotationEntry (HsCmdLam {})              = NoEntryVal
   getAnnotationEntry (HsCmdPar an _ _ _)        = fromAnn an
   getAnnotationEntry (HsCmdCase an _ _)         = fromAnn an
-  getAnnotationEntry (HsCmdLamCase an _)        = fromAnn an
+  getAnnotationEntry (HsCmdLamCase an _ _)      = fromAnn an
   getAnnotationEntry (HsCmdIf an _ _ _ _)       = fromAnn an
   getAnnotationEntry (HsCmdLet an _ _ _ _)      = fromAnn an
   getAnnotationEntry (HsCmdDo an _)             = fromAnn an
@@ -2368,9 +2374,10 @@ instance ExactPrint (HsCmd GhcPs) where
     markAnnotated alts
     markEpAnn' an hsCaseAnnsRest AnnCloseC
 
-  exact (HsCmdLamCase an matches) = do
+  exact (HsCmdLamCase an lc_variant matches) = do
     markEpAnn an AnnLam
-    markEpAnn an AnnCase
+    markEpAnn an case lc_variant of LamCase -> AnnCase
+                                    LamCases -> AnnCases
     markAnnotated matches
 
   exact (HsCmdIf an _ e1 e2 e3) = do
diff --git a/utils/check-exact/Lookup.hs b/utils/check-exact/Lookup.hs
index 18e4e32f6f..3cd53be04c 100644
--- a/utils/check-exact/Lookup.hs
+++ b/utils/check-exact/Lookup.hs
@@ -38,6 +38,7 @@ keywordToString kw =
       (G AnnBackquote ) -> "`"
       (G AnnBy     ) -> "by"
       (G AnnCase   ) -> "case"
+      (G AnnCases  ) -> "cases"
       (G AnnClass   ) -> "class"
       (G AnnCloseB  ) -> "|)"
       (G AnnCloseBU ) -> "⦈"