Commit 51eb739f authored by cgibbard's avatar cgibbard Committed by Jonathan DK Gibbons

Refactor the MatchResult type in the desugarer so that it does a better job of...

Refactor the MatchResult type in the desugarer so that it does a better job of proving whether or not the fail operator is used.

(cherry picked from commit 2e6155e1)
parent ea1581cb
......@@ -6,10 +6,14 @@
@DsMonad@: monadery used in desugaring
-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} -- instance MonadThings is necessarily an orphan
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} -- instance MonadThings is necessarily an orphan
module DsMonad (
DsM, mapM, mapAndUnzipM,
initDs, initDsTc, initTcDsForSolver, initDsWithModGuts, fixDs,
......@@ -42,8 +46,7 @@ module DsMonad (
-- Data types
DsMatchContext(..),
EquationInfo(..), MatchResult(..), DsWrapper, idDsWrapper,
CanItFail(..), orFail,
EquationInfo(..), MatchResult'(..), MatchResult, runMatchResult, DsWrapper, idDsWrapper,
-- Levity polymorphism
dsNoLevPoly, dsNoLevPolyExpr, dsWhenNoErrs,
......@@ -134,21 +137,28 @@ idDsWrapper e = e
-- \fail. wrap (case vs of { pats -> rhs fail })
-- where vs are not bound by wrap
-- A MatchResult is an expression with a hole in it
data MatchResult
= MatchResult
CanItFail -- Tells whether the failure expression is used
(CoreExpr -> DsM CoreExpr)
-- Takes a expression to plug in at the
-- failure point(s). The expression should
-- be duplicatable!
data CanItFail = CanFail | CantFail
orFail :: CanItFail -> CanItFail -> CanItFail
orFail CantFail CantFail = CantFail
orFail _ _ = CanFail
-- This is a value of type a with potentially a CoreExpr-shaped hole in it. We explicitly represent
-- the case where there is no hole. This is used to deal with cases where we are potentially handling
-- pattern match failure, and want to later specify how failure is handled.
data MatchResult' a
= MatchResult_Unfailable (DsM a)
| MatchResult_Failable (CoreExpr -> DsM a)
deriving (Functor)
instance Applicative MatchResult' where
pure v = MatchResult_Unfailable (pure v)
MatchResult_Unfailable f <*> MatchResult_Unfailable x = MatchResult_Unfailable (f <*> x)
f <*> x = MatchResult_Failable $ \fail -> runMatchResult fail f <*> runMatchResult fail x
-- This is a CoreExpr with potentially a CoreExpr hole in it, which is the most common case.
type MatchResult = MatchResult' CoreExpr
-- Given a fail expression to use, and a MatchResult, compute the filled CoreExpr whether
-- the MatchResult was failable or not.
runMatchResult :: CoreExpr -> MatchResult' a -> DsM a
runMatchResult fail = \case
MatchResult_Unfailable body -> body
MatchResult_Failable body_fn -> body_fn fail
{-
************************************************************************
......
This diff is collapsed.
......@@ -234,7 +234,7 @@ match vars@(v:_) ty eqns -- Eqns *can* be empty
matchEmpty :: MatchId -> Type -> DsM [MatchResult]
-- See Note [Empty case expressions]
matchEmpty var res_ty
= return [MatchResult CanFail mk_seq]
= return [MatchResult_Failable mk_seq]
where
mk_seq fail = return $ mkWildCase (Var var) (idType var) res_ty
[(DEFAULT, [], fail)]
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment