diff options
| author | Josef Svenningsson <josefs@fb.com> | 2019-04-29 17:29:35 -0700 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-10-28 09:20:34 -0400 |
| commit | 6635a3f67d8e8ebafeccfdce35490601039fe216 (patch) | |
| tree | b8ee8130325706dab4036acc3025a5e1c2057841 /compiler/deSugar/Coverage.hs | |
| parent | 90d06fd04d7efeae337a6902887a5f67393755d7 (diff) | |
| download | haskell-6635a3f67d8e8ebafeccfdce35490601039fe216.tar.gz | |
Fix #15344: use fail when desugaring applicative-do
Applicative-do has a bug where it fails to use the monadic fail method
when desugaring patternmatches which can fail. See #15344.
This patch fixes that problem. It required more rewiring than I had expected.
Applicative-do happens mostly in the renamer; that's where decisions about
scheduling are made. This schedule is then carried through the typechecker and
into the desugarer which performs the actual translation. Fixing this bug
required sending information about the fail method from the renamer, through
the type checker and into the desugarer. Previously, the desugarer didn't
have enough information to actually desugar pattern matches correctly.
As a side effect, we also fix #16628, where GHC wouldn't catch missing
MonadFail instances with -XApplicativeDo.
Diffstat (limited to 'compiler/deSugar/Coverage.hs')
| -rw-r--r-- | compiler/deSugar/Coverage.hs | 3 |
1 files changed, 2 insertions, 1 deletions
diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs index 6138c26ec2..6dd6d37a9a 100644 --- a/compiler/deSugar/Coverage.hs +++ b/compiler/deSugar/Coverage.hs @@ -769,11 +769,12 @@ addTickApplicativeArg addTickApplicativeArg isGuard (op, arg) = liftM2 (,) (addTickSyntaxExpr hpcSrcSpan op) (addTickArg arg) where - addTickArg (ApplicativeArgOne x pat expr isBody) = + addTickArg (ApplicativeArgOne x pat expr isBody fail) = (ApplicativeArgOne x) <$> addTickLPat pat <*> addTickLHsExpr expr <*> pure isBody + <*> addTickSyntaxExpr hpcSrcSpan fail addTickArg (ApplicativeArgMany x stmts ret pat) = (ApplicativeArgMany x) <$> addTickLStmts isGuard stmts |