Fix bug in TcLambdaCase
authorRichard Eisenberg <eir@cis.upenn.edu>
Wed, 15 Jul 2015 17:23:56 +0000 (13:23 -0400)
committerRichard Eisenberg <eir@cis.upenn.edu>
Wed, 15 Jul 2015 17:23:56 +0000 (13:23 -0400)
compiler/typecheck/TcEvidence.hs
compiler/typecheck/TcExpr.hs

index 299e6a2..0848008 100644 (file)
@@ -595,7 +595,10 @@ WpHole <.> c = c
 c <.> WpHole = c
 c1 <.> c2    = c1 `WpCompose` c2
 
-mkWpFun :: HsWrapper -> HsWrapper -> TcType -> TcType -> HsWrapper
+mkWpFun :: HsWrapper -> HsWrapper
+        -> TcType    -- the "from" type of the first wrapper
+        -> TcType    -- the "to" type of the second wrapper
+        -> HsWrapper
 mkWpFun WpHole       WpHole       _  _  = WpHole
 mkWpFun WpHole       (WpCast co2) t1 _  = WpCast (mkTcFunCo Representational (mkTcRepReflCo t1) co2)
 mkWpFun (WpCast co1) WpHole       _  t2 = WpCast (mkTcFunCo Representational (mkTcSymCo co1) (mkTcRepReflCo t2))
index 26ce358..d93f5ba 100644 (file)
@@ -200,7 +200,8 @@ tcExpr e@(HsLamCase _ matches) res_ty
   = do {(wrap1, [arg_ty], body_ty) <-
             matchExpectedFunTys Expected msg 1 res_ty
        ; (wrap2, matches') <- tcMatchesCase match_ctxt arg_ty matches body_ty
-       ; return $ mkHsWrap (wrap1 <.> wrap2) $ HsLamCase arg_ty matches' }
+       ; return $ mkHsWrap (wrap1 <.> mkWpFun idHsWrapper wrap2 arg_ty body_ty) $
+                  HsLamCase arg_ty matches' }
   where msg = sep [ ptext (sLit "The function") <+> quotes (ppr e)
                   , ptext (sLit "requires")]
         match_ctxt = MC { mc_what = CaseAlt, mc_body = tcBody }