[commit: ghc] wip/type-app: Avoid unnecessary call to tcSubType (fff3d43)

[git at git.haskell.org]

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

On branch  : wip/type-app
Link       : http://ghc.haskell.org/trac/ghc/changeset/fff3d4388a14e45ae302df7d6368a0956fd34464/ghc

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

commit fff3d4388a14e45ae302df7d6368a0956fd34464
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Wed Jul 29 15:41:06 2015 -0400

    Avoid unnecessary call to tcSubType
    
    The unnecessary call resulted in an unexpected ambiguity check.


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

fff3d4388a14e45ae302df7d6368a0956fd34464
 compiler/deSugar/DsBinds.hs     |  2 +-
 compiler/typecheck/TcMatches.hs | 15 ++++++++-------
 2 files changed, 9 insertions(+), 8 deletions(-)

diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs
index da1a014..a17f710 100644
--- a/compiler/deSugar/DsBinds.hs
+++ b/compiler/deSugar/DsBinds.hs
@@ -145,11 +145,11 @@ dsHsBind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts
         ; let core_bind = Rec (fromOL bind_prs)
         ; ds_binds <- dsTcEvBinds_s ev_binds
         ; inner_rhs <- dsHsWrapper inst_wrap $
-                       mkCoreLets ds_binds $
                        Let core_bind $
                        Var local
         ; rhs <- dsHsWrapper wrap $  -- Usually the identity
                  mkLams tyvars $ mkLams dicts $
+                 mkCoreLets ds_binds $
                  inner_rhs
 
         ; (spec_binds, rules) <- dsSpecs rhs prags
diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs
index 940679c..d635c54 100644
--- a/compiler/typecheck/TcMatches.hs
+++ b/compiler/typecheck/TcMatches.hs
@@ -186,14 +186,15 @@ data TcMatchCtxt body   -- c.f. TcStmtCtxt, also in this module
 
 tcMatches ctxt pat_tys rhs_ty group@(MG { mg_alts = matches, mg_origin = origin })
   = ASSERT( not (null matches) )        -- Ensure that rhs_ty is filled in
-    do  { rhs_ty' <-
+    do  { (matches', wrap, rhs_ty') <-
              if isSingletonMatchGroup group
-                  -- no need to monomorphise the RHS if there's only one
-             then return rhs_ty
-                  -- TODO (RAE): Document this behavior.
-             else tauTvsForReturnTvs rhs_ty
-        ; matches' <- mapM (tcMatch ctxt pat_tys rhs_ty') matches
-        ; wrap <- tcSubTypeHR rhs_ty' rhs_ty
+             then do { matches' <- mapM (tcMatch ctxt pat_tys rhs_ty) matches
+                     ; return (matches', idHsWrapper, rhs_ty) }
+             else do { rhs_ty' <- tauTvsForReturnTvs rhs_ty
+                      -- TODO (RAE): Document this behavior.
+                     ; matches' <- mapM (tcMatch ctxt pat_tys rhs_ty') matches
+                     ; wrap <- tcSubTypeHR rhs_ty' rhs_ty
+                     ; return (matches', wrap, rhs_ty') }
         ; return (wrap, MG { mg_alts = matches'
                            , mg_arg_tys = pat_tys
                            , mg_res_ty = rhs_ty'