X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcPat.lhs;h=9c845b6555342e72d45134a23f26220f6fc924ba;hb=06f6f35dadc461336675e6d2b8a2192b1f518a1b;hp=f2201548d1dab2bea76bab3ab86cb99ef86e54f5;hpb=91d5084fd9b9c6d2c5a91a0f0e00599ab0aa7954;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index f220154..9c845b6 100644
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -421,7 +421,9 @@ tc_pat pstate (orig@(ViewPat expr pat _)) overall_pat_ty thing_inside
          -- (view -> f)    where view :: _ -> forall b. b
          -- we will only be able to use view at one instantation in the
          -- rest of the view
-	; (expr_coerc, pat_ty) <- tcInfer (\ pat_ty -> tcSubExp (expr'_expected pat_ty) expr'_inferred)
+	; (expr_coerc, pat_ty) <- tcInfer $ \ pat_ty -> 
+		tcSubExp ViewPatOrigin (expr'_expected pat_ty) expr'_inferred
+
          -- pattern must have pat_ty
        ; (pat', tvs, res) <- tc_lpat pat pat_ty pstate thing_inside
          -- this should get zonked later on, but we unBox it here