InstInfo(..), pprInstInfo, simpleInstInfoTyCon, simpleInstInfoTy,
newDFunName, tcExtendTyVarEnv
)
-import InstEnv ( InstEnv, classDataCon, extendInstEnv )
+import InstEnv ( InstEnv, extendInstEnv )
import TcMonoType ( tcTyVars, tcHsSigType, kcHsSigType )
import TcSimplify ( tcSimplifyAndCheck )
import TcType ( zonkTcSigTyVars )
)
import Bag ( unionManyBags )
+import DataCon ( classDataCon )
import Class ( Class, DefMeth(..), classBigSig )
import Var ( idName, idType )
import Maybes ( maybeToBool )
import NameSet ( emptyNameSet, nameSetToList )
import PrelInfo ( eRROR_ID )
import PprType ( pprConstraint, pprPred )
-import TyCon ( TyCon, isSynTyCon, tyConDerivings )
+import TyCon ( TyCon, isSynTyCon )
import Type ( splitDFunTy, isTyVarTy,
splitTyConApp_maybe, splitDictTy,
splitAlgTyConApp_maybe, splitForAllTys,
tcInstDecls1 inst_env0 prs hst unf_env get_fixity mod tycons decls
= let
- inst_decls = [inst_decl | InstD inst_decl <- decls]
- clas_decls = [clas_decl | TyClD clas_decl <- decls, isClassDecl clas_decl]
+ inst_decls = [inst_decl | InstD inst_decl <- decls]
+ tycl_decls = [decl | TyClD decl <- decls]
+ clas_decls = filter isClassDecl tycl_decls
in
-- (1) Do the ordinary instance declarations
mapNF_Tc (tcInstDecl1 mod unf_env) inst_decls `thenNF_Tc` \ inst_infos ->
-- we ignore deriving decls from interfaces!
-- This stuff computes a context for the derived instance decl, so it
-- needs to know about all the instances possible; hecne inst_env4
- tcDeriving prs mod inst_env4 get_fixity tycons `thenTc` \ (deriv_inst_info, deriv_binds) ->
+ tcDeriving prs mod inst_env4 get_fixity tycl_decls `thenTc` \ (deriv_inst_info, deriv_binds) ->
addInstInfos inst_env4 deriv_inst_info `thenNF_Tc` \ final_inst_env ->
returnTc (inst_env1,
&& not (creturnable_type first_inst_tau))
-> addErrTc (nonBoxedPrimCCallErr clas first_inst_tau)
- -- DERIVING CHECK
- -- It is obviously illegal to have an explicit instance
- -- for something that we are also planning to `derive'
- | maybeToBool alg_tycon_app_maybe && clas `elem` (tyConDerivings alg_tycon)
- -> addErrTc (derivingWhenInstanceExistsErr clas first_inst_tau)
- -- Kind check will have ensured inst_taus is of length 1
-
-- Allow anything for AllowUndecidableInstances
| dopt Opt_AllowUndecidableInstances dflags
-> returnNF_Tc ()
nest 4 (parens msg)
]
-derivingWhenInstanceExistsErr clas tycon
- = hang (hsep [ptext SLIT("Deriving class"),
- quotes (ppr clas),
- ptext SLIT("type"), quotes (ppr tycon)])
- 4 (ptext SLIT("when an explicit instance exists"))
-
nonBoxedPrimCCallErr clas inst_ty
= hang (ptext SLIT("Unacceptable instance type for ccall-ish class"))
4 (hsep [ ptext SLIT("class"), ppr clas, ptext SLIT("type"),