Commit 401f7bb3 authored by John Ericson's avatar John Ericson Committed by Marge Bot
Browse files

`MatchResult'` -> `MatchResult`

Inline `MatchResult` alias accordingly.
parent 72cb6bcc
Pipeline #18457 passed with stages
in 430 minutes and 58 seconds
......@@ -1014,7 +1014,7 @@ dsDo stmts
go _ (ParStmt {}) _ = panic "dsDo ParStmt"
go _ (TransStmt {}) _ = panic "dsDo TransStmt"
dsHandleMonadicFailure :: LPat GhcTc -> MatchResult -> FailOperator GhcTc -> DsM CoreExpr
dsHandleMonadicFailure :: LPat GhcTc -> MatchResult CoreExpr -> FailOperator GhcTc -> DsM CoreExpr
-- In a do expression, pattern-match failure just calls
-- the monadic 'fail' rather than throwing an exception
dsHandleMonadicFailure pat match m_fail_op =
......
......@@ -9,4 +9,4 @@ dsLExpr, dsLExprNoLP :: LHsExpr GhcTc -> DsM CoreExpr
dsSyntaxExpr :: SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
dsLocalBinds :: LHsLocalBinds GhcTc -> CoreExpr -> DsM CoreExpr
dsHandleMonadicFailure :: LPat GhcTc -> MatchResult -> FailOperator GhcTc -> DsM CoreExpr
dsHandleMonadicFailure :: LPat GhcTc -> MatchResult CoreExpr -> FailOperator GhcTc -> DsM CoreExpr
......@@ -52,7 +52,7 @@ dsGuarded grhss rhs_ty mb_rhss_deltas = do
error_expr <- mkErrorAppDs nON_EXHAUSTIVE_GUARDS_ERROR_ID rhs_ty empty
extractMatchResult match_result error_expr
-- In contrast, @dsGRHSs@ produces a @MatchResult@.
-- In contrast, @dsGRHSs@ produces a @MatchResult CoreExpr@.
dsGRHSs :: HsMatchContext GhcRn
-> GRHSs GhcTc (LHsExpr GhcTc) -- ^ Guarded RHSs
......@@ -60,7 +60,7 @@ dsGRHSs :: HsMatchContext GhcRn
-> Maybe (NonEmpty Deltas) -- ^ Refined pattern match checking
-- models, one for each GRHS. Defaults
-- to 'initDeltas' if 'Nothing'.
-> DsM MatchResult
-> DsM (MatchResult CoreExpr)
dsGRHSs hs_ctx (GRHSs _ grhss binds) rhs_ty mb_rhss_deltas
= ASSERT( notNull grhss )
do { match_results <- case toList <$> mb_rhss_deltas of
......@@ -73,14 +73,14 @@ dsGRHSs hs_ctx (GRHSs _ grhss binds) rhs_ty mb_rhss_deltas
; return match_result2 }
dsGRHS :: HsMatchContext GhcRn -> Type -> Deltas -> LGRHS GhcTc (LHsExpr GhcTc)
-> DsM MatchResult
-> DsM (MatchResult CoreExpr)
dsGRHS hs_ctx rhs_ty rhs_deltas (L _ (GRHS _ guards rhs))
= updPmDeltas rhs_deltas (matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs rhs_ty)
{-
************************************************************************
* *
* matchGuard : make a MatchResult from a guarded RHS *
* matchGuard : make a MatchResult CoreExpr CoreExpr from a guarded RHS *
* *
************************************************************************
-}
......@@ -89,7 +89,7 @@ matchGuards :: [GuardStmt GhcTc] -- Guard
-> HsStmtContext GhcRn -- Context
-> LHsExpr GhcTc -- RHS
-> Type -- Type of RHS of guard
-> DsM MatchResult
-> DsM (MatchResult CoreExpr)
-- See comments with HsExpr.Stmt re what a BodyStmt means
-- Here we must be in a guard context (not do-expression, nor list-comp)
......
......@@ -174,7 +174,7 @@ type MatchId = Id -- See Note [Match Ids]
match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with. See Note [Match Ids]
-> Type -- ^ Type of the case expression
-> [EquationInfo] -- ^ Info about patterns, etc. (type synonym below)
-> DsM MatchResult -- ^ Desugared result!
-> DsM (MatchResult CoreExpr) -- ^ Desugared result!
match [] ty eqns
= ASSERT2( not (null eqns), ppr ty )
......@@ -207,12 +207,12 @@ match (v:vs) ty eqns -- Eqns *can* be empty
dropGroup :: Functor f => f (PatGroup,EquationInfo) -> f EquationInfo
dropGroup = fmap snd
match_groups :: [NonEmpty (PatGroup,EquationInfo)] -> DsM (NonEmpty MatchResult)
-- Result list of [MatchResult] is always non-empty
match_groups :: [NonEmpty (PatGroup,EquationInfo)] -> DsM (NonEmpty (MatchResult CoreExpr))
-- Result list of [MatchResult CoreExpr] is always non-empty
match_groups [] = matchEmpty v ty
match_groups (g:gs) = mapM match_group $ g :| gs
match_group :: NonEmpty (PatGroup,EquationInfo) -> DsM MatchResult
match_group :: NonEmpty (PatGroup,EquationInfo) -> DsM (MatchResult CoreExpr)
match_group eqns@((group,_) :| _)
= case group of
PgCon {} -> matchConFamily vars ty (ne $ subGroupUniq [(c,e) | (PgCon c, e) <- eqns'])
......@@ -246,7 +246,7 @@ match (v:vs) ty eqns -- Eqns *can* be empty
maybeWarn $ (map (\g -> text "Putting these view expressions into the same case:" <+> (ppr g))
(filter (not . null) gs))
matchEmpty :: MatchId -> Type -> DsM (NonEmpty MatchResult)
matchEmpty :: MatchId -> Type -> DsM (NonEmpty (MatchResult CoreExpr))
-- See Note [Empty case expressions]
matchEmpty var res_ty
= return [MR_Fallible mk_seq]
......@@ -254,18 +254,18 @@ matchEmpty var res_ty
mk_seq fail = return $ mkWildCase (Var var) (idType var) res_ty
[(DEFAULT, [], fail)]
matchVariables :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM MatchResult
matchVariables :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr)
-- Real true variables, just like in matchVar, SLPJ p 94
-- No binding to do: they'll all be wildcards by now (done in tidy)
matchVariables (_ :| vars) ty eqns = match vars ty $ NEL.toList $ shiftEqns eqns
matchBangs :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM MatchResult
matchBangs :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr)
matchBangs (var :| vars) ty eqns
= do { match_result <- match (var:vars) ty $ NEL.toList $
decomposeFirstPat getBangPat <$> eqns
; return (mkEvalMatchResult var ty match_result) }
matchCoercion :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM MatchResult
matchCoercion :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr)
-- Apply the coercion to the match variable and then match that
matchCoercion (var :| vars) ty (eqns@(eqn1 :| _))
= do { let CoPat _ co pat _ = firstPat eqn1
......@@ -277,7 +277,7 @@ matchCoercion (var :| vars) ty (eqns@(eqn1 :| _))
; let bind = NonRec var' (core_wrap (Var var))
; return (mkCoLetMatchResult bind match_result) }
matchView :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM MatchResult
matchView :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr)
-- Apply the view function to the match variable and then match that
matchView (var :| vars) ty (eqns@(eqn1 :| _))
= do { -- we could pass in the expr from the PgView,
......@@ -295,7 +295,7 @@ matchView (var :| vars) ty (eqns@(eqn1 :| _))
(mkCoreAppDs (text "matchView") viewExpr' (Var var))
match_result) }
matchOverloadedList :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM MatchResult
matchOverloadedList :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr)
matchOverloadedList (var :| vars) ty (eqns@(eqn1 :| _))
-- Since overloaded list patterns are treated as view patterns,
-- the code is roughly the same as for matchView
......@@ -830,7 +830,7 @@ matchSimply scrut hs_ctx pat result_expr fail_expr = do
extractMatchResult match_result' fail_expr
matchSinglePat :: CoreExpr -> HsMatchContext GhcRn -> LPat GhcTc
-> Type -> MatchResult -> DsM MatchResult
-> Type -> MatchResult CoreExpr -> DsM (MatchResult CoreExpr)
-- matchSinglePat ensures that the scrutinee is a variable
-- and then calls matchSinglePatVar
--
......@@ -850,7 +850,7 @@ matchSinglePat scrut hs_ctx pat ty match_result
matchSinglePatVar :: Id -- See Note [Match Ids]
-> HsMatchContext GhcRn -> LPat GhcTc
-> Type -> MatchResult -> DsM MatchResult
-> Type -> MatchResult CoreExpr -> DsM (MatchResult CoreExpr)
matchSinglePatVar var ctx pat ty match_result
= ASSERT2( isInternalName (idName var), ppr var )
do { dflags <- getDynFlags
......
......@@ -11,7 +11,7 @@ import GHC.Hs.Extension ( GhcRn, GhcTc )
match :: [Id]
-> Type
-> [EquationInfo]
-> DsM MatchResult
-> DsM (MatchResult CoreExpr)
matchWrapper
:: HsMatchContext GhcRn
......@@ -32,5 +32,5 @@ matchSinglePatVar
-> HsMatchContext GhcRn
-> LPat GhcTc
-> Type
-> MatchResult
-> DsM MatchResult
-> MatchResult CoreExpr
-> DsM (MatchResult CoreExpr)
......@@ -27,6 +27,7 @@ import GHC.Types.Basic ( Origin(..) )
import GHC.Tc.Utils.TcType
import GHC.HsToCore.Monad
import GHC.HsToCore.Utils
import GHC.Core ( CoreExpr )
import GHC.Core.Make ( mkCoreLets )
import Util
import GHC.Types.Id
......@@ -94,7 +95,7 @@ have-we-used-all-the-constructors? question; the local function
matchConFamily :: NonEmpty Id
-> Type
-> NonEmpty (NonEmpty EquationInfo)
-> DsM MatchResult
-> DsM (MatchResult CoreExpr)
-- Each group of eqns is for a single constructor
matchConFamily (var :| vars) ty groups
= do alts <- mapM (fmap toRealAlt . matchOneConLike vars ty) groups
......@@ -107,7 +108,7 @@ matchConFamily (var :| vars) ty groups
matchPatSyn :: NonEmpty Id
-> Type
-> NonEmpty EquationInfo
-> DsM MatchResult
-> DsM (MatchResult CoreExpr)
matchPatSyn (var :| vars) ty eqns
= do alt <- fmap toSynAlt $ matchOneConLike vars ty eqns
return (mkCoSynCaseMatchResult var ty alt)
......@@ -134,7 +135,7 @@ matchOneConLike vars ty (eqn1 :| eqns) -- All eqns for a single constructor
-- and returns the types of the *value* args, which is what we want
match_group :: [Id]
-> [(ConArgPats, EquationInfo)] -> DsM MatchResult
-> [(ConArgPats, EquationInfo)] -> DsM (MatchResult CoreExpr)
-- All members of the group have compatible ConArgPats
match_group arg_vars arg_eqn_prs
= ASSERT( notNull arg_eqn_prs )
......
......@@ -407,7 +407,7 @@ tidyNPat over_lit mb_neg eq outer_ty
matchLiterals :: NonEmpty Id
-> Type -- ^ Type of the whole case expression
-> NonEmpty (NonEmpty EquationInfo) -- ^ All PgLits
-> DsM MatchResult
-> DsM (MatchResult CoreExpr)
matchLiterals (var :| vars) ty sub_groups
= do { -- Deal with each group
......@@ -424,7 +424,7 @@ matchLiterals (var :| vars) ty sub_groups
return (mkCoPrimCaseMatchResult var ty $ NEL.toList alts)
}
where
match_group :: NonEmpty EquationInfo -> DsM (Literal, MatchResult)
match_group :: NonEmpty EquationInfo -> DsM (Literal, MatchResult CoreExpr)
match_group eqns@(firstEqn :| _)
= do { dflags <- getDynFlags
; let platform = targetPlatform dflags
......@@ -432,7 +432,7 @@ matchLiterals (var :| vars) ty sub_groups
; match_result <- match vars ty (NEL.toList $ shiftEqns eqns)
; return (hsLitKey platform hs_lit, match_result) }
wrap_str_guard :: Id -> (Literal,MatchResult) -> DsM MatchResult
wrap_str_guard :: Id -> (Literal,MatchResult CoreExpr) -> DsM (MatchResult CoreExpr)
-- Equality check for string literals
wrap_str_guard eq_str (LitString s, mr)
= do { -- We now have to convert back to FastString. Perhaps there
......@@ -473,7 +473,7 @@ hsLitKey _ l = pprPanic "hsLitKey" (ppr l)
************************************************************************
-}
matchNPats :: NonEmpty Id -> Type -> NonEmpty EquationInfo -> DsM MatchResult
matchNPats :: NonEmpty Id -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr)
matchNPats (var :| vars) ty (eqn1 :| eqns) -- All for the same literal
= do { let NPat _ (L _ lit) mb_neg eq_chk = firstPat eqn1
; lit_expr <- dsOverLit lit
......@@ -502,7 +502,7 @@ We generate:
\end{verbatim}
-}
matchNPlusKPats :: NonEmpty Id -> Type -> NonEmpty EquationInfo -> DsM MatchResult
matchNPlusKPats :: NonEmpty Id -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr)
-- All NPlusKPats, for the *same* literal k
matchNPlusKPats (var :| vars) ty (eqn1 :| eqns)
= do { let NPlusKPat _ (L _ n1) (L _ lit1) lit2 ge minus
......
......@@ -46,7 +46,7 @@ module GHC.HsToCore.Monad (
-- Data types
DsMatchContext(..),
EquationInfo(..), MatchResult'(..), MatchResult, runMatchResult, DsWrapper, idDsWrapper,
EquationInfo(..), MatchResult (..), runMatchResult, DsWrapper, idDsWrapper,
-- Levity polymorphism
dsNoLevPoly, dsNoLevPolyExpr, dsWhenNoErrs,
......@@ -122,7 +122,7 @@ data EquationInfo
-- @W# -1## :: Word@, but we shouldn't warn about an overflowed
-- literal for /both/ of these cases.
, eqn_rhs :: MatchResult
, eqn_rhs :: MatchResult CoreExpr
-- ^ What to do after match
}
......@@ -133,14 +133,14 @@ type DsWrapper = CoreExpr -> CoreExpr
idDsWrapper :: DsWrapper
idDsWrapper e = e
-- The semantics of (match vs (EqnInfo wrap pats rhs)) is the MatchResult
-- The semantics of (match vs (EqnInfo wrap pats rhs)) is the MatchResult CoreExpr
-- \fail. wrap (case vs of { pats -> rhs fail })
-- where vs are not bound by wrap
-- | This is a value of type a with potentially a CoreExpr-shaped hole in it.
-- 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
data MatchResult a
-- | We represent the case where there is no hole without a function from
-- 'CoreExpr', like this, because sometimes we have nothing to put in the
-- hole and so want to be sure there is in fact no hole.
......@@ -154,17 +154,14 @@ data MatchResult' a
-- This is useful for combining a bunch of alternatives together and then
-- getting the overall falliblity of the entire group. See 'mkDataConCase' for
-- an example.
instance Applicative MatchResult' where
instance Applicative MatchResult where
pure v = MR_Infallible (pure v)
MR_Infallible f <*> MR_Infallible x = MR_Infallible (f <*> x)
f <*> x = MR_Fallible $ \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
-- Given a fail expression to use, and a MatchResult CoreExpr, compute the filled CoreExpr whether
-- the MatchResult CoreExpr was failable or not.
runMatchResult :: CoreExpr -> MatchResult a -> DsM a
runMatchResult fail = \case
MR_Infallible body -> body
MR_Fallible body_fn -> body_fn fail
......
......@@ -19,7 +19,7 @@ module GHC.HsToCore.Utils (
EquationInfo(..),
firstPat, shiftEqns,
MatchResult'(..), MatchResult, CaseAlt(..),
MatchResult (..), CaseAlt(..),
cantFailMatchResult, alwaysFailMatchResult,
extractMatchResult, combineMatchResults,
adjustMatchResultDs,
......@@ -195,25 +195,25 @@ shiftEqns :: Functor f => f EquationInfo -> f EquationInfo
-- Drop the first pattern in each equation
shiftEqns = fmap $ \eqn -> eqn { eqn_pats = tail (eqn_pats eqn) }
-- Functions on MatchResults
-- Functions on MatchResult CoreExprs
matchCanFail :: MatchResult' a -> Bool
matchCanFail :: MatchResult a -> Bool
matchCanFail (MR_Fallible {}) = True
matchCanFail (MR_Infallible {}) = False
alwaysFailMatchResult :: MatchResult
alwaysFailMatchResult :: MatchResult CoreExpr
alwaysFailMatchResult = MR_Fallible $ \fail -> return fail
cantFailMatchResult :: CoreExpr -> MatchResult
cantFailMatchResult :: CoreExpr -> MatchResult CoreExpr
cantFailMatchResult expr = MR_Infallible $ return expr
extractMatchResult :: MatchResult -> CoreExpr -> DsM CoreExpr
extractMatchResult :: MatchResult CoreExpr -> CoreExpr -> DsM CoreExpr
extractMatchResult match_result failure_expr =
runMatchResult
failure_expr
(shareFailureHandler match_result)
combineMatchResults :: MatchResult -> MatchResult -> MatchResult
combineMatchResults :: MatchResult CoreExpr -> MatchResult CoreExpr -> MatchResult CoreExpr
combineMatchResults match_result1@(MR_Infallible _) _
= match_result1
combineMatchResults match_result1 match_result2 =
......@@ -225,7 +225,7 @@ combineMatchResults match_result1 match_result2 =
-- Before actually failing, try the next match arm.
body_fn1 =<< runMatchResult fail_expr match_result2
adjustMatchResultDs :: (a -> DsM b) -> MatchResult' a -> MatchResult' b
adjustMatchResultDs :: (a -> DsM b) -> MatchResult a -> MatchResult b
adjustMatchResultDs encl_fn = \case
MR_Infallible body_fn -> MR_Infallible $
encl_fn =<< body_fn
......@@ -244,27 +244,27 @@ wrapBind new old body -- NB: this function must deal with term
seqVar :: Var -> CoreExpr -> CoreExpr
seqVar var body = mkDefaultCase (Var var) var body
mkCoLetMatchResult :: CoreBind -> MatchResult -> MatchResult
mkCoLetMatchResult :: CoreBind -> MatchResult CoreExpr -> MatchResult CoreExpr
mkCoLetMatchResult bind = fmap (mkCoreLet bind)
-- (mkViewMatchResult var' viewExpr mr) makes the expression
-- let var' = viewExpr in mr
mkViewMatchResult :: Id -> CoreExpr -> MatchResult -> MatchResult
mkViewMatchResult :: Id -> CoreExpr -> MatchResult CoreExpr -> MatchResult CoreExpr
mkViewMatchResult var' viewExpr = fmap $ mkCoreLet $ NonRec var' viewExpr
mkEvalMatchResult :: Id -> Type -> MatchResult -> MatchResult
mkEvalMatchResult :: Id -> Type -> MatchResult CoreExpr -> MatchResult CoreExpr
mkEvalMatchResult var ty = fmap $ \e ->
Case (Var var) var ty [(DEFAULT, [], e)]
mkGuardedMatchResult :: CoreExpr -> MatchResult -> MatchResult
mkGuardedMatchResult :: CoreExpr -> MatchResult CoreExpr -> MatchResult CoreExpr
mkGuardedMatchResult pred_expr mr = MR_Fallible $ \fail -> do
body <- runMatchResult fail mr
return (mkIfThenElse pred_expr body fail)
mkCoPrimCaseMatchResult :: Id -- Scrutinee
-> Type -- Type of the case
-> [(Literal, MatchResult)] -- Alternatives
-> MatchResult -- Literals are all unlifted
-> [(Literal, MatchResult CoreExpr)] -- Alternatives
-> MatchResult CoreExpr -- Literals are all unlifted
mkCoPrimCaseMatchResult var ty match_alts
= MR_Fallible mk_case
where
......@@ -281,13 +281,13 @@ mkCoPrimCaseMatchResult var ty match_alts
data CaseAlt a = MkCaseAlt{ alt_pat :: a,
alt_bndrs :: [Var],
alt_wrapper :: HsWrapper,
alt_result :: MatchResult }
alt_result :: MatchResult CoreExpr }
mkCoAlgCaseMatchResult
:: Id -- ^ Scrutinee
-> Type -- ^ Type of exp
-> NonEmpty (CaseAlt DataCon) -- ^ Alternatives (bndrs *include* tyvars, dicts)
-> MatchResult
-> MatchResult CoreExpr
mkCoAlgCaseMatchResult var ty match_alts
| isNewtype -- Newtype case; use a let
= ASSERT( null match_alts_tail && null (tail arg_ids1) )
......@@ -310,7 +310,7 @@ mkCoAlgCaseMatchResult var ty match_alts
-- (not that splitTyConApp does, these days)
newtype_rhs = unwrapNewTypeBody tc ty_args (Var var)
mkCoSynCaseMatchResult :: Id -> Type -> CaseAlt PatSyn -> MatchResult
mkCoSynCaseMatchResult :: Id -> Type -> CaseAlt PatSyn -> MatchResult CoreExpr
mkCoSynCaseMatchResult var ty alt = MR_Fallible $ mkPatSynCase var ty alt
mkPatSynCase :: Id -> Type -> CaseAlt PatSyn -> CoreExpr -> DsM CoreExpr
......@@ -331,7 +331,7 @@ mkPatSynCase var ty alt fail = do
ensure_unstrict cont | needs_void_lam = Lam voidArgId cont
| otherwise = cont
mkDataConCase :: Id -> Type -> NonEmpty (CaseAlt DataCon) -> MatchResult
mkDataConCase :: Id -> Type -> NonEmpty (CaseAlt DataCon) -> MatchResult CoreExpr
mkDataConCase var ty alts@(alt1 :| _)
= liftA2 mk_case mk_default mk_alts
-- The liftA2 combines the failability of all the alternatives and the default
......@@ -351,10 +351,10 @@ mkDataConCase var ty alts@(alt1 :| _)
mk_case def alts = mkWildCase (Var var) (idType var) ty $
maybeToList def ++ alts
mk_alts :: MatchResult' [CoreAlt]
mk_alts :: MatchResult [CoreAlt]
mk_alts = traverse mk_alt sorted_alts
mk_alt :: CaseAlt DataCon -> MatchResult' CoreAlt
mk_alt :: CaseAlt DataCon -> MatchResult CoreAlt
mk_alt MkCaseAlt { alt_pat = con
, alt_bndrs = args
, alt_result = match_result } =
......@@ -366,7 +366,7 @@ mkDataConCase var ty alts@(alt1 :| _)
let (rep_ids, binds) = initUs_ us (boxer ty_args args)
return (DataAlt con, rep_ids, mkLets binds body)
mk_default :: MatchResult' (Maybe CoreAlt)
mk_default :: MatchResult (Maybe CoreAlt)
mk_default
| exhaustive_case = MR_Infallible $ return Nothing
| otherwise = MR_Fallible $ \fail -> return $ Just (DEFAULT, [], fail)
......@@ -853,7 +853,7 @@ mkFailurePair expr
-- Uses '@mkFailurePair@' to bind the failure case. Infallible matches have
-- neither a failure arg or failure "hole", so nothing is let-bound, and no
-- extraneous Core is produced.
shareFailureHandler :: MatchResult -> MatchResult
shareFailureHandler :: MatchResult CoreExpr -> MatchResult CoreExpr
shareFailureHandler = \case
mr@(MR_Infallible _) -> mr
MR_Fallible match_fn -> MR_Fallible $ \fail_expr -> do
......
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