Commit 3ae18df1 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Minor refactoring

Use tauifyExpType rather than something hand-rolled
parent 0f0b002c
......@@ -533,9 +533,10 @@ tcExpr (HsCase scrut matches) res_ty
tcExpr (HsIf Nothing pred b1 b2) res_ty -- Ordinary 'if'
= do { pred' <- tcMonoExpr pred (mkCheckExpType boolTy)
-- this forces the branches to be fully instantiated
-- (See #10619)
; res_ty <- mkCheckExpType <$> expTypeToType res_ty
; res_ty <- tauifyExpType res_ty
-- Just like Note [Case branches must never infer a non-tau type]
-- in TcMatches (See #10619)
; b1' <- tcMonoExpr b1 res_ty
; b2' <- tcMonoExpr b2 res_ty
; return (HsIf Nothing pred' b1' b2') }
......@@ -553,9 +554,10 @@ tcExpr (HsIf (Just fun) pred b1 b2) res_ty
tcExpr (HsMultiIf _ alts) res_ty
= do { res_ty <- if isSingleton alts
then return res_ty
else mkCheckExpType <$> expTypeToType res_ty
-- Just like Note [Case branches must never infer a non-tau type]
-- in TcMatches
else tauifyExpType res_ty
-- Just like TcMatches
-- Note [Case branches must never infer a non-tau type]
; alts' <- mapM (wrapLocM $ tcGRHS match_ctxt res_ty) alts
; res_ty <- readExpType res_ty
; return (HsMultiIf res_ty alts') }
......
......@@ -90,8 +90,7 @@ tcMatchesFun fn@(L _ fun_name) matches exp_ty
do { (matches', wrap_fun)
<- matchExpectedFunTys herald arity exp_rho $
\ pat_tys rhs_ty ->
-- See Note [Case branches must never infer a non-tau type]
do { tcMatches match_ctxt pat_tys rhs_ty matches }
tcMatches match_ctxt pat_tys rhs_ty matches
; return (wrap_fun, matches') }
; return (wrap_gen <.> wrap_fun, group) }
where
......@@ -187,10 +186,7 @@ tauifyMultipleMatches group exp_tys
| otherwise = mapM tauifyExpType exp_tys
-- NB: In the empty-match case, this ensures we fill in the ExpType
-- | Type-check a MatchGroup. If there are multiple RHSs, the expected type
-- must already be tauified.
-- See Note [Case branches must never infer a non-tau type]
-- about tauifyMultipleMatches
-- | Type-check a MatchGroup.
tcMatches :: (Outputable (body Name)) => TcMatchCtxt body
-> [ExpSigmaType] -- Expected pattern types
-> ExpRhoType -- Expected result-type of the Match.
......@@ -207,6 +203,8 @@ data TcMatchCtxt body -- c.f. TcStmtCtxt, also in this module
tcMatches ctxt pat_tys rhs_ty (MG { mg_alts = L l matches
, mg_origin = origin })
= do { rhs_ty:pat_tys <- tauifyMultipleMatches matches (rhs_ty:pat_tys)
-- See Note [Case branches must never infer a non-tau type]
; matches' <- mapM (tcMatch ctxt pat_tys rhs_ty) matches
; pat_tys <- mapM readExpType pat_tys
; rhs_ty <- readExpType rhs_ty
......
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