From a346683b2ba5cc87a0db27eb1422158611327c54 Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Sat, 23 Sep 2006 07:24:07 +0000
Subject: [PATCH] Fix origin for addDataConStupidTheta

---
 compiler/typecheck/TcExpr.lhs |   11 +++++------
 compiler/typecheck/TcPat.lhs  |   11 +++++++----
 2 files changed, 12 insertions(+), 10 deletions(-)

diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index 6354499..4eb7b10 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -775,7 +775,7 @@ instFun orig fun subst tv_theta_prs
   = do 	{ let ty_theta_prs' = map subst_pr tv_theta_prs
 
                 -- Make two ad-hoc checks 
-	; doStupidChecks orig fun ty_theta_prs'
+	; doStupidChecks fun ty_theta_prs'
 
 		-- Now do normal instantiation
 	; go True fun ty_theta_prs' }
@@ -891,8 +891,7 @@ Here's are two cases that should fail
 
 
 \begin{code}
-doStupidChecks :: InstOrigin
-	       -> HsExpr TcId
+doStupidChecks :: HsExpr TcId
 	       -> [([TcType], ThetaType)]
 	       -> TcM ()
 -- Check two tiresome and ad-hoc cases
@@ -900,9 +899,9 @@ doStupidChecks :: InstOrigin
 --     from the "stupid theta" of a data constructor (sigh)
 -- (b) deal with the tagToEnum# problem: see Note [tagToEnum#]
 
-doStupidChecks orig (HsVar fun_id) ((tys,_):_)
+doStupidChecks (HsVar fun_id) ((tys,_):_)
   | Just con <- isDataConId_maybe fun_id   -- (a)
-  = addDataConStupidTheta orig con tys
+  = addDataConStupidTheta con tys
 
   | fun_id `hasKey` tagToEnumKey           -- (b)
   = do	{ tys' <- zonkTcTypes tys
@@ -914,7 +913,7 @@ doStupidChecks orig (HsVar fun_id) ((tys,_):_)
 			Just (tc,_) -> isEnumerationTyCon tc
 			Nothing     -> False
 
-doStupidChecks orig fun tv_theta_prs
+doStupidChecks fun tv_theta_prs
   = return () -- The common case
 				      
 
diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 8b99276..f3a779b 100644
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -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 $
@@ -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
-- 
1.7.10.4