[commit: ghc] master: Minor refactoring (3ae18df)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/3ae18df176081474ecc1ae90d5b6957d660afbb6/ghc

>---------------------------------------------------------------

commit 3ae18df176081474ecc1ae90d5b6957d660afbb6
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Jun 9 14:44:00 2016 +0100

    Minor refactoring
    
    Use tauifyExpType rather than something hand-rolled


>---------------------------------------------------------------

3ae18df176081474ecc1ae90d5b6957d660afbb6
 compiler/typecheck/TcExpr.hs    | 14 ++++++++------
 compiler/typecheck/TcMatches.hs | 10 ++++------
 2 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 25a62cb..f078ba4 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -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') }
diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs
index d4867f5..8d59b8f 100644
--- a/compiler/typecheck/TcMatches.hs
+++ b/compiler/typecheck/TcMatches.hs
@@ -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