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

Inline `adjustMatchResult`

It is just `fmap`
parent dcb7fe5a
......@@ -130,7 +130,7 @@ matchGuards (BindStmt _ pat bind_rhs : stmts) ctx rhs rhs_ty = do
core_rhs <- dsLExpr bind_rhs
match_result' <- matchSinglePatVar match_var (StmtCtxt ctx) pat rhs_ty
match_result
pure $ adjustMatchResult (bindNonRec match_var core_rhs) match_result'
pure $ bindNonRec match_var core_rhs <$> match_result'
matchGuards (LastStmt {} : _) _ _ _ = panic "matchGuards LastStmt"
matchGuards (ParStmt {} : _) _ _ _ = panic "matchGuards ParStmt"
......
......@@ -198,8 +198,9 @@ match (v:vs) ty eqns -- Eqns *can* be empty
; whenDOptM Opt_D_dump_view_pattern_commoning (debug grouped)
; match_results <- match_groups grouped
; return (adjustMatchResult (foldr (.) id aux_binds) $
foldr1 combineMatchResults match_results) }
; return $ foldr (.) id aux_binds <$>
foldr1 combineMatchResults match_results
}
where
vars = v :| vs
......@@ -844,7 +845,8 @@ matchSinglePat (Var var) ctx pat ty match_result
matchSinglePat scrut hs_ctx pat ty match_result
= do { var <- selectSimpleMatchVarL pat
; match_result' <- matchSinglePatVar var hs_ctx pat ty match_result
; return (adjustMatchResult (bindNonRec var scrut) match_result') }
; return $ bindNonRec var scrut <$> match_result'
}
matchSinglePatVar :: Id -- See Note [Match Ids]
-> HsMatchContext GhcRn -> LPat GhcTc
......
......@@ -141,7 +141,8 @@ matchOneConLike vars ty (eqn1 :| eqns) -- All eqns for a single constructor
do { (wraps, eqns') <- liftM unzip (mapM shift arg_eqn_prs)
; let group_arg_vars = select_arg_vars arg_vars arg_eqn_prs
; match_result <- match (group_arg_vars ++ vars) ty eqns'
; return (adjustMatchResult (foldr1 (.) wraps) match_result) }
; return $ foldr1 (.) wraps <$> match_result
}
shift (_, eqn@(EqnInfo { eqn_pats = ConPatOut{ pat_tvs = tvs, pat_dicts = ds,
pat_binds = bind, pat_args = args
......
......@@ -515,7 +515,7 @@ matchNPlusKPats (var :| vars) ty (eqn1 :| eqns)
; match_result <- match vars ty eqns'
; return (mkGuardedMatchResult pred_expr $
mkCoLetMatchResult (NonRec n1 minusk_expr) $
adjustMatchResult (foldr1 (.) wraps) $
fmap (foldr1 (.) wraps) $
match_result) }
where
shift n1 eqn@(EqnInfo { eqn_pats = NPlusKPat _ (L _ n) _ _ _ _ : pats })
......
......@@ -22,7 +22,7 @@ module GHC.HsToCore.Utils (
MatchResult'(..), MatchResult, CaseAlt(..),
cantFailMatchResult, alwaysFailMatchResult,
extractMatchResult, combineMatchResults,
adjustMatchResult, adjustMatchResultDs,
adjustMatchResultDs,
shareFailureHandler,
mkCoLetMatchResult, mkViewMatchResult, mkGuardedMatchResult,
matchCanFail, mkEvalMatchResult,
......@@ -225,9 +225,6 @@ combineMatchResults match_result1 match_result2 =
-- Before actually failing, try the next match arm.
body_fn1 =<< runMatchResult fail_expr match_result2
adjustMatchResult :: (a -> b) -> MatchResult' a -> MatchResult' b
adjustMatchResult = fmap
adjustMatchResultDs :: (a -> DsM b) -> MatchResult' a -> MatchResult' b
adjustMatchResultDs encl_fn = \case
MR_Infallible body_fn -> MR_Infallible $
......@@ -248,17 +245,16 @@ seqVar :: Var -> CoreExpr -> CoreExpr
seqVar var body = mkDefaultCase (Var var) var body
mkCoLetMatchResult :: CoreBind -> MatchResult -> MatchResult
mkCoLetMatchResult bind = adjustMatchResult (mkCoreLet bind)
mkCoLetMatchResult bind = fmap (mkCoreLet bind)
-- (mkViewMatchResult var' viewExpr mr) makes the expression
-- let var' = viewExpr in mr
mkViewMatchResult :: Id -> CoreExpr -> MatchResult -> MatchResult
mkViewMatchResult var' viewExpr =
adjustMatchResult (mkCoreLet (NonRec var' viewExpr))
mkViewMatchResult var' viewExpr = fmap $ mkCoreLet $ NonRec var' viewExpr
mkEvalMatchResult :: Id -> Type -> MatchResult -> MatchResult
mkEvalMatchResult var ty
= adjustMatchResult (\e -> Case (Var var) var ty [(DEFAULT, [], e)])
mkEvalMatchResult var ty = fmap $ \e ->
Case (Var var) var ty [(DEFAULT, [], e)]
mkGuardedMatchResult :: CoreExpr -> MatchResult -> MatchResult
mkGuardedMatchResult pred_expr mr = MR_Fallible $ \fail -> 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