X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcInstDcls.lhs;h=baa751529c6221a8894b1026b3d0da901f6db310;hp=e7c472b4751cbf3d863b209687da1596e0256eea;hb=46934dd87e13143ec2e97f075309a9e2c0945889;hpb=e79c9ce01d0ce4412bd4bcd99c8c728a6a2ec569 diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index e7c472b..baa7515 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -21,7 +21,7 @@ import FamInst import FamInstEnv import TcDeriv import TcEnv -import RnEnv ( lookupImportedName ) +import RnEnv ( lookupGlobalOccRn ) import TcHsType import TcUnify import TcSimplify @@ -461,11 +461,11 @@ tcLocalInstDecl1 (L loc (InstDecl poly_ty binds uprags ats)) ; mapM_ (checkIndexes clas inst_tys) ats } - checkIndexes clas inst_tys (hsAT, ATyCon tycon) = + checkIndexes clas inst_tys (hsAT, ATyCon tycon) -- !!!TODO: check that this does the Right Thing for indexed synonyms, too! - checkIndexes' clas inst_tys hsAT - (tyConTyVars tycon, - snd . fromJust . tyConFamInst_maybe $ tycon) + = checkIndexes' clas inst_tys hsAT + (tyConTyVars tycon, + snd . fromJust . tyConFamInst_maybe $ tycon) checkIndexes _ _ _ = panic "checkIndexes" checkIndexes' clas (instTvs, instTys) hsAT (atTvs, atTys) @@ -475,8 +475,8 @@ tcLocalInstDecl1 (L loc (InstDecl poly_ty binds uprags ats)) addErrCtxt (atInstCtxt atName) $ case find ((atName ==) . tyConName) (classATs clas) of Nothing -> addErrTc $ badATErr clas atName -- not in this class - Just atDecl -> - case assocTyConArgPoss_maybe atDecl of + Just atycon -> + case assocTyConArgPoss_maybe atycon of Nothing -> panic "checkIndexes': AT has no args poss?!?" Just poss -> @@ -487,6 +487,13 @@ tcLocalInstDecl1 (L loc (InstDecl poly_ty binds uprags ats)) -- which must be type variables; and (3) variables in AT and -- instance head will be different `Name's even if their -- source lexemes are identical. + -- + -- e.g. class C a b c where + -- data D b a :: * -> * -- NB (1) b a, omits c + -- instance C [x] Bool Char where + -- data D Bool [x] v = MkD x [v] -- NB (2) v + -- -- NB (3) the x in 'instance C...' have differnt + -- -- Names to x's in 'data D...' -- -- Re (1), `poss' contains a permutation vector to extract the -- class parameters in the right order. @@ -863,7 +870,7 @@ tcInstanceMethod loc clas tyvars dfun_dicts theta inst_tys { -- Build the typechecked version directly, -- without calling typecheck_method; -- see Note [Default methods in instances] - dm_name <- lookupImportedName (mkDefMethRdrName sel_name) + dm_name <- lookupGlobalOccRn (mkDefMethRdrName sel_name) -- Might not be imported, but will be an OrigName ; dm_id <- tcLookupId dm_name ; return (wrapId dm_wrapper dm_id, emptyBag) } } @@ -963,7 +970,7 @@ mustBeVarArgErr ty = wrongATArgErr :: Type -> Type -> SDoc wrongATArgErr ty instTy = sep [ ptext (sLit "Type indexes must match class instance head") - , ptext (sLit "Found") <+> ppr ty <+> ptext (sLit "but expected") <+> - ppr instTy + , ptext (sLit "Found") <+> quotes (ppr ty) + <+> ptext (sLit "but expected") <+> quotes (ppr instTy) ] \end{code}