X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcInstDcls.lhs;h=d314e1e21f0b5e479bb5cccf5ed72e2ae554847f;hb=b99310f05faee2abec850da4349fcd5c0498f7ca;hp=b4d34983680bd4b8c80b155c8ddc3a91a5cee5f7;hpb=e3dd39bf230380f02d73efc287226117bb2eb47f;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index b4d3498..d314e1e 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -179,7 +179,10 @@ tcInstDecls1 tycl_decls inst_decls deriv_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 @@ -252,7 +255,7 @@ tcLocalInstDecl1 decl@(L loc (InstDecl poly_ty binds uprags ats)) -- 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 @@ -582,10 +585,11 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = VanillaInst monobinds uprags }) 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 @@ -638,7 +642,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = VanillaInst monobinds uprags }) 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