From defa8d16860add244593aa1430866e090d4b8cf0 Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Wed, 20 Sep 2006 18:52:40 +0000 Subject: [PATCH] SPJ's fix to resolve conflict in instFun Wed Sep 20 02:27:26 EDT 2006 Manuel M T Chakravarty * SPJ's fix to resolve conflict in instFun --- compiler/typecheck/TcExpr.lhs | 38 +++++++++++++++++++++----------------- 1 file changed, 21 insertions(+), 17 deletions(-) diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs index d68e8b0..6354499 100644 --- a/compiler/typecheck/TcExpr.lhs +++ b/compiler/typecheck/TcExpr.lhs @@ -772,14 +772,10 @@ instFun orig fun subst [] = return fun -- Common short cut instFun orig fun subst tv_theta_prs - = do { -- !!!SPJ: -- Horrid check for tagToEnum; see Note [tagToEnum#] - -- !!!SPJ: checkBadTagToEnumCall fun_id qtv_tys + = do { let ty_theta_prs' = map subst_pr tv_theta_prs - ; let ty_theta_prs' = map subst_pr tv_theta_prs - - -- First, chuck in the constraints from - -- the "stupid theta" of a data constructor (sigh) - ; inst_stupid fun ty_theta_prs' + -- Make two ad-hoc checks + ; doStupidChecks orig fun ty_theta_prs' -- Now do normal instantiation ; go True fun ty_theta_prs' } @@ -787,11 +783,6 @@ instFun orig fun subst tv_theta_prs subst_pr (tvs, theta) = (map (substTyVar subst) tvs, substTheta subst theta) - inst_stupid (HsVar fun_id) ((tys,_):_) - | Just con <- isDataConId_maybe fun_id - = addDataConStupidTheta orig con tys - inst_stupid _ _ = return () - go _ fun [] = return fun go True (HsVar fun_id) ((tys,theta) : prs) @@ -900,20 +891,33 @@ Here's are two cases that should fail \begin{code} -checkBadTagToEnumCall :: Id -> [TcType] -> TcM () -checkBadTagToEnumCall fun_id tys - | fun_id `hasKey` tagToEnumKey +doStupidChecks :: InstOrigin + -> HsExpr TcId + -> [([TcType], ThetaType)] + -> TcM () +-- Check two tiresome and ad-hoc cases +-- (a) the "stupid theta" for a data con; add the constraints +-- from the "stupid theta" of a data constructor (sigh) +-- (b) deal with the tagToEnum# problem: see Note [tagToEnum#] + +doStupidChecks orig (HsVar fun_id) ((tys,_):_) + | Just con <- isDataConId_maybe fun_id -- (a) + = addDataConStupidTheta orig con tys + + | fun_id `hasKey` tagToEnumKey -- (b) = do { tys' <- zonkTcTypes tys ; checkTc (ok tys') (tagToEnumError tys') } - | otherwise -- Vastly common case - = return () where ok [] = False ok (ty:tys) = case tcSplitTyConApp_maybe ty of Just (tc,_) -> isEnumerationTyCon tc Nothing -> False +doStupidChecks orig fun tv_theta_prs + = return () -- The common case + + tagToEnumError tys = hang (ptext SLIT("Bad call to tagToEnum#") <+> at_type) 2 (vcat [ptext SLIT("Specify the type by giving a type signature"), -- 1.7.10.4