diff options
| author | Jakob Bruenker <jakob.bruenker@gmail.com> | 2022-03-21 00:14:25 +0100 |
|---|---|---|
| committer | Jakob Bruenker <jakob.bruenker@gmail.com> | 2022-03-31 17:45:37 +0200 |
| commit | a9c0c69b42657d39f26ab822241900ba0f308dc3 (patch) | |
| tree | fd59a5e49146ee436e04137b313d8e4178c2bed0 /compiler/GHC/HsToCore/Coverage.hs | |
| parent | dda46e2da13268c239db3290720b014cef00c01d (diff) | |
| download | haskell-wip/T20768.tar.gz | |
Implement \cases (Proposal 302)wip/T20768
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 'compiler/GHC/HsToCore/Coverage.hs')
| -rw-r--r-- | compiler/GHC/HsToCore/Coverage.hs | 30 |
1 files changed, 15 insertions, 15 deletions
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs index e1e8489fe1..8fececdcea 100644 --- a/compiler/GHC/HsToCore/Coverage.hs +++ b/compiler/GHC/HsToCore/Coverage.hs @@ -536,19 +536,19 @@ addTickHsExpr e@(HsVar _ (L _ id)) = do freeVar id; return e addTickHsExpr e@(HsUnboundVar {}) = return e addTickHsExpr e@(HsRecSel _ (FieldOcc id _)) = do freeVar id; return e -addTickHsExpr e@(HsIPVar {}) = return e -addTickHsExpr e@(HsOverLit {}) = return e -addTickHsExpr e@(HsOverLabel{}) = return e -addTickHsExpr e@(HsLit {}) = return e -addTickHsExpr (HsLam x mg) = liftM (HsLam x) - (addTickMatchGroup True mg) -addTickHsExpr (HsLamCase x mgs) = liftM (HsLamCase x) - (addTickMatchGroup True mgs) -addTickHsExpr (HsApp x e1 e2) = liftM2 (HsApp x) (addTickLHsExprNever e1) - (addTickLHsExpr e2) -addTickHsExpr (HsAppType x e ty) = liftM3 HsAppType (return x) - (addTickLHsExprNever e) - (return ty) +addTickHsExpr e@(HsIPVar {}) = return e +addTickHsExpr e@(HsOverLit {}) = return e +addTickHsExpr e@(HsOverLabel{}) = return e +addTickHsExpr e@(HsLit {}) = return e +addTickHsExpr (HsLam x mg) = liftM (HsLam x) + (addTickMatchGroup True mg) +addTickHsExpr (HsLamCase x lc_variant mgs) = liftM (HsLamCase x lc_variant) + (addTickMatchGroup True mgs) +addTickHsExpr (HsApp x e1 e2) = liftM2 (HsApp x) (addTickLHsExprNever e1) + (addTickLHsExpr e2) +addTickHsExpr (HsAppType x e ty) = liftM3 HsAppType (return x) + (addTickLHsExprNever e) + (return ty) addTickHsExpr (OpApp fix e1 e2 e3) = liftM4 OpApp (return fix) @@ -891,8 +891,8 @@ addTickHsCmd (HsCmdCase x e mgs) = liftM2 (HsCmdCase x) (addTickLHsExpr e) (addTickCmdMatchGroup mgs) -addTickHsCmd (HsCmdLamCase x mgs) = - liftM (HsCmdLamCase x) (addTickCmdMatchGroup mgs) +addTickHsCmd (HsCmdLamCase x lc_variant mgs) = + liftM (HsCmdLamCase x lc_variant) (addTickCmdMatchGroup mgs) addTickHsCmd (HsCmdIf x cnd e1 c2 c3) = liftM3 (HsCmdIf x cnd) (addBinTickLHsExpr (BinBox CondBinBox) e1) |