X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcPat.lhs;h=a4f3a82521385903f2bf4e57a42c9b83d1caf658;hb=365ab3dad0f9a77e01758a14bf3817dea0ee2a31;hp=8b99276c770665192d80e9f2448b29f7a0c0fbc9;hpb=a8ac6f833f37a0507df0a84fbbff1d1ff1936533;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 8b99276..a4f3a82 100644
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -11,7 +11,7 @@ module TcPat ( tcLetPat, tcLamPat, tcLamPats, tcOverloadedLit,
 
 import {-# SOURCE #-}	TcExpr( tcSyntaxOp )
 import HsSyn		( Pat(..), LPat, HsConDetails(..), HsLit(..),
-			  HsOverLit(..), HsExpr(..), ExprCoFn(..),
+			  HsOverLit(..), HsExpr(..), HsWrapper(..),
 			  mkCoPat, 
 			  LHsBinds, emptyLHsBinds, isEmptyLHsBinds, 
 			  collectPatsBinders, nlHsLit )
@@ -51,7 +51,7 @@ import Type		( Type, mkTyConApp, substTys, substTheta )
 import StaticFlags	( opt_IrrefutableTuples )
 import TyCon		( TyCon, FieldLabel, tyConFamInst_maybe,
 			  tyConFamilyCoercion_maybe, tyConTyVars )
-import DataCon		( DataCon, dataConTyCon, dataConFullSig, 
+import DataCon		( DataCon, dataConTyCon, dataConFullSig, dataConName,
 			  dataConFieldLabels, dataConSourceArity, 
 			  dataConStupidTheta, dataConUnivTyVars )
 import PrelNames	( integralClassName, fromIntegerName, integerTyConName, 
@@ -571,7 +571,7 @@ tcConPat pstate con_span data_con tycon pat_ty arg_pats thing_inside
 	; dicts <- newDictBndrs loc theta'
 	; dict_binds <- tcSimplifyCheck doc ex_tvs' dicts lie_req
 
-	; addDataConStupidTheta origin data_con ctxt_res_tys
+	; addDataConStupidTheta data_con ctxt_res_tys
 
 	; return
 	    (unwrapFamInstScrutinee tycon ctxt_res_tys $
@@ -616,7 +616,7 @@ tcConPat pstate con_span data_con tycon pat_ty arg_pats thing_inside
           -- NB: We can use CoPat directly, rather than mkCoPat, as we know the
           --	 coercion is not the identity; mkCoPat is inconvenient as it
           --	 wants a located pattern.
-      = CoPat (ExprCoFn $ mkTyConApp co_con args)       -- co fam ty to repr ty
+      = CoPat (WpCo $ mkTyConApp co_con args)       -- co fam ty to repr ty
 	      (pat {pat_ty = mkTyConApp tycon args})    -- representation type
 	      pat_ty					-- family inst type
       | otherwise
@@ -697,13 +697,16 @@ tcConArg (arg_pat, arg_ty) pstate thing_inside
 \end{code}
 
 \begin{code}
-addDataConStupidTheta :: InstOrigin -> DataCon -> [TcType] -> TcM ()
+addDataConStupidTheta :: DataCon -> [TcType] -> TcM ()
 -- Instantiate the "stupid theta" of the data con, and throw 
 -- the constraints into the constraint set
-addDataConStupidTheta origin data_con inst_tys
+addDataConStupidTheta data_con inst_tys
   | null stupid_theta = return ()
   | otherwise	      = instStupidTheta origin inst_theta
   where
+    origin = OccurrenceOf (dataConName data_con)
+	-- The origin should always report "occurrence of C"
+	-- even when C occurs in a pattern
     stupid_theta = dataConStupidTheta data_con
     tenv = zipTopTvSubst (dataConUnivTyVars data_con) inst_tys
     inst_theta = substTheta tenv stupid_theta