-- (they recover, so that we get more than one error each
-- round)
- -- (1) Do class instance declarations and instances of indexed
- -- types
- ; let { idxty_decls = filter (isIdxTyDecl . unLoc) tycl_decls }
+ -- (1) Do class and family instance declarations
+ ; let { idxty_decls = filter (isFamInstDecl . unLoc) tycl_decls }
; local_info_tycons <- mappM tcLocalInstDecl1 inst_decls
; idx_tycons <- mappM tcIdxTyInstDeclTL idxty_decls
-- (4) Compute instances from "deriving" clauses;
-- This stuff computes a context for the derived instance
-- decl, so it needs to know about all the instances possible
- ; (deriv_inst_info, deriv_binds) <- tcDeriving tycl_decls deriv_decls
+ -- NB: class instance declarations can contain derivings as
+ -- part of associated data type declarations
+ ; (deriv_inst_info, deriv_binds) <- tcDeriving tycl_decls inst_decls
+ deriv_decls
; addInsts deriv_inst_info $ do {
; gbl_env <- getGblEnv
-- !!!TODO: Need to perform this check for the TyThing of type functions,
-- too.
tcIdxTyInstDeclTL ldecl@(L loc decl) =
- do { tything <- tcIdxTyInstDecl ldecl
+ do { tything <- tcFamInstDecl ldecl
; setSrcSpan loc $
when (isAssocFamily tything) $
addErr $ assocInClassErr (tcdName decl)
; checkTc (not is_boot || (isEmptyLHsBinds binds && null uprags))
badBootDeclErr
- -- Typecheck the instance type itself. We can't use
- -- tcHsSigType, because it's not a valid user type.
- ; kinded_ty <- kcHsSigType poly_ty
- ; poly_ty' <- tcHsKindedType kinded_ty
- ; let (tyvars, theta, tau) = tcSplitSigmaTy poly_ty'
+ ; (tyvars, theta, tau) <- tcHsInstHead poly_ty
-- Next, process any associated types.
- ; idx_tycons <- mappM tcIdxTyInstDecl ats
+ ; idx_tycons <- mappM tcFamInstDecl ats
-- Now, check the validity of the instance.
; (clas, inst_tys) <- checkValidInstHead tau
-- Finally, construct the Core representation of the instance.
-- (This no longer includes the associated types.)
- ; dfun_name <- newDFunName clas inst_tys (srcSpanStart loc)
+ ; dfun_name <- newDFunName clas inst_tys loc
; overlap_flag <- getOverlapFlag
; let dfun = mkDictFunId dfun_name tyvars theta clas inst_tys
ispec = mkLocalInstance dfun overlap_flag
checkValidAndMissingATs clas inst_tys ats
= do { -- Issue a warning for each class AT that is not defined in this
-- instance.
- ; let classDefATs = listToNameSet . map tyConName . classATs $ clas
- definedATs = listToNameSet . map (tcdName.unLoc.fst) $ ats
- omitted = classDefATs `minusNameSet` definedATs
+ ; let class_ats = map tyConName (classATs clas)
+ defined_ats = listToNameSet . map (tcdName.unLoc.fst) $ ats
+ omitted = filterOut (`elemNameSet` defined_ats) class_ats
; warn <- doptM Opt_WarnMissingMethods
- ; mapM_ (warnTc warn . omittedATWarn) (nameSetToList omitted)
+ ; mapM_ (warnTc warn . omittedATWarn) omitted
-- Ensure that all AT indexes that correspond to class parameters
-- coincide with the types in the instance head. All remaining
dfun_id = instanceDFunId ispec
rigid_info = InstSkol
inst_ty = idType dfun_id
+ loc = srcLocSpan (getSrcLoc dfun_id)
in
-- Prime error recovery
recoverM (returnM emptyLHsBinds) $
- setSrcSpan (srcLocSpan (getSrcLoc dfun_id)) $
+ setSrcSpan loc $
addErrCtxt (instDeclCtxt2 (idType dfun_id)) $
-- Instantiate the instance decl with skolem constants
scs_and_meths = map instToId sc_dicts ++ meth_ids
this_dict_id = instToId this_dict
inline_prag | null dfun_arg_dicts = []
- | otherwise = [InlinePrag (Inline AlwaysActive True)]
+ | otherwise = [L loc (InlinePrag (Inline AlwaysActive True))]
-- Always inline the dfun; this is an experimental decision
-- because it makes a big performance difference sometimes.
-- Often it means we can do the method selection, and then