diff options
author | Jakob Bruenker <jakob.bruenker@gmail.com> | 2022-03-21 00:14:25 +0100 |
---|---|---|
committer | Jakob Bruenker <jakob.bruenker@gmail.com> | 2022-04-01 20:31:08 +0200 |
commit | 32070e6c2e1b4b7c32530a9566fe14543791f9a6 (patch) | |
tree | f0913ef2a69fd660542723ec07240167dbd37961 /utils | |
parent | d85c7dcb7c457efc23b20ac8f4e4ae88bae5b050 (diff) | |
download | haskell-32070e6c2e1b4b7c32530a9566fe14543791f9a6.tar.gz |
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
Diffstat (limited to 'utils')
-rw-r--r-- | utils/check-exact/ExactPrint.hs | 23 | ||||
-rw-r--r-- | utils/check-exact/Lookup.hs | 1 | ||||
m--------- | utils/haddock | 0 |
3 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 ) -> "⦈" diff --git a/utils/haddock b/utils/haddock -Subproject 58237d76c96325f25627bfd7cdad5b93364d29a +Subproject fb0e9bac0a5297f995b151f25aa1ce3e622e12e |