= 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' }
\begin{code}
-doStupidChecks :: InstOrigin
- -> HsExpr TcId
+doStupidChecks :: HsExpr TcId
-> [([TcType], ThetaType)]
-> TcM ()
-- Check two tiresome and ad-hoc cases
-- 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
Just (tc,_) -> isEnumerationTyCon tc
Nothing -> False
-doStupidChecks orig fun tv_theta_prs
+doStupidChecks fun tv_theta_prs
= return () -- The common case
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,
; 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 $
\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