summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
0760818)
--------------------------------------
Finally get rid of tcAddImportedIdInfo
--------------------------------------
TcEnv.tcAddImportedIdInfo is a notorious source of space leaks.
Simon M got rid of the need for it on default methods.
This commit gets rid of the need for it for dictionary function Ids,
and finally nukes the beast altogether. Hurrah!
The change really involves putting tcInterfaceSigs *before*
tcInstDecls1, so that any imported DFunIds are in the typechecker's
environment before we get to tcInstDecls.
hsDeclName, instDeclName,
tyClDeclName, tyClDeclNames, tyClDeclSysNames, tyClDeclTyVars,
isClassDecl, isSynDecl, isDataDecl, isIfaceSigDecl, countTyClDecls,
hsDeclName, instDeclName,
tyClDeclName, tyClDeclNames, tyClDeclSysNames, tyClDeclTyVars,
isClassDecl, isSynDecl, isDataDecl, isIfaceSigDecl, countTyClDecls,
- mkClassDeclSysNames, isIfaceRuleDecl, ifaceRuleDeclName,
+ mkClassDeclSysNames, isIfaceRuleDecl, isIfaceInstDecl, ifaceRuleDeclName,
getClassDeclSysNames, conDetailsTys,
collectRuleBndrSigTys
) where
getClassDeclSysNames, conDetailsTys,
collectRuleBndrSigTys
) where
import SrcLoc ( SrcLoc )
import FastString
import SrcLoc ( SrcLoc )
import FastString
-import Maybe ( isNothing, fromJust )
+import Maybe ( isNothing, isJust, fromJust )
-- Nothing for source-file instance decls
SrcLoc
-- Nothing for source-file instance decls
SrcLoc
+
+isIfaceInstDecl :: InstDecl name pat -> Bool
+isIfaceInstDecl (InstDecl _ _ _ maybe_dfun _) = isJust maybe_dfun
import HsSyn ( HsDecl(..), InstDecl(..), TyClDecl(..), HsType(..),
MonoBinds(..), HsExpr(..), HsLit(..), Sig(..), HsTyVarBndr(..),
import HsSyn ( HsDecl(..), InstDecl(..), TyClDecl(..), HsType(..),
MonoBinds(..), HsExpr(..), HsLit(..), Sig(..), HsTyVarBndr(..),
- andMonoBindList, collectMonoBinders, isClassDecl, toHsType
+ andMonoBindList, collectMonoBinders,
+ isClassDecl, isIfaceInstDecl, toHsType
)
import RnHsSyn ( RenamedHsBinds, RenamedInstDecl, RenamedHsDecl,
RenamedMonoBinds, RenamedTyClDecl, RenamedHsType,
)
import RnHsSyn ( RenamedHsBinds, RenamedInstDecl, RenamedHsDecl,
RenamedMonoBinds, RenamedTyClDecl, RenamedHsType,
LIE, mkLIE, emptyLIE, plusLIE, plusLIEs )
import TcDeriv ( tcDeriving )
import TcEnv ( TcEnv, tcExtendGlobalValEnv,
LIE, mkLIE, emptyLIE, plusLIE, plusLIEs )
import TcDeriv ( tcDeriving )
import TcEnv ( TcEnv, tcExtendGlobalValEnv,
- tcExtendTyVarEnvForMeths,
+ tcExtendTyVarEnvForMeths, tcLookupId,
tcAddImportedIdInfo, tcLookupClass,
InstInfo(..), pprInstInfo, simpleInstInfoTyCon,
simpleInstInfoTy, newDFunName,
tcAddImportedIdInfo, tcLookupClass,
InstInfo(..), pprInstInfo, simpleInstInfoTyCon,
simpleInstInfoTy, newDFunName,
inst_decls = [inst_decl | InstD inst_decl <- decls]
tycl_decls = [decl | TyClD decl <- decls]
clas_decls = filter isClassDecl tycl_decls
inst_decls = [inst_decl | InstD inst_decl <- decls]
tycl_decls = [decl | TyClD decl <- decls]
clas_decls = filter isClassDecl tycl_decls
+ (imported_inst_ds, local_inst_ds) = partition isIfaceInstDecl inst_decls
in
-- (1) Do the ordinary instance declarations
in
-- (1) Do the ordinary instance declarations
- mapNF_Tc tcInstDecl1 inst_decls `thenNF_Tc` \ inst_infos ->
+ mapNF_Tc tcInstDecl1 local_inst_ds `thenNF_Tc` \ local_inst_infos ->
+ mapNF_Tc tcInstDecl1 imported_inst_ds `thenNF_Tc` \ imported_inst_infos ->
-- (2) Instances from generic class declarations
getGenericInstances clas_decls `thenTc` \ generic_inst_info ->
-- (2) Instances from generic class declarations
getGenericInstances clas_decls `thenTc` \ generic_inst_info ->
-- e) generic instances inst_env4
-- The result of (b) replaces the cached InstEnv in the PCS
let
-- e) generic instances inst_env4
-- The result of (b) replaces the cached InstEnv in the PCS
let
- (local_inst_info, imported_inst_info)
- = partition (isLocalThing this_mod . iDFunId) (concat inst_infos)
-
- imported_dfuns = map (tcAddImportedIdInfo unf_env . iDFunId)
- imported_inst_info
- hst_dfuns = foldModuleEnv ((++) . md_insts) [] hst
+ local_inst_info = concat local_inst_infos
+ imported_inst_info = concat imported_inst_infos
+ hst_dfuns = foldModuleEnv ((++) . md_insts) [] hst
in
-- pprTrace "tcInstDecls" (vcat [ppr imported_dfuns, ppr hst_dfuns]) $
in
-- pprTrace "tcInstDecls" (vcat [ppr imported_dfuns, ppr hst_dfuns]) $
- addInstDFuns inst_env0 imported_dfuns `thenNF_Tc` \ inst_env1 ->
+ addInstInfos inst_env0 imported_inst_info `thenNF_Tc` \ inst_env1 ->
addInstDFuns inst_env1 hst_dfuns `thenNF_Tc` \ inst_env2 ->
addInstInfos inst_env2 local_inst_info `thenNF_Tc` \ inst_env3 ->
addInstInfos inst_env3 generic_inst_info `thenNF_Tc` \ inst_env4 ->
addInstDFuns inst_env1 hst_dfuns `thenNF_Tc` \ inst_env2 ->
addInstInfos inst_env2 local_inst_info `thenNF_Tc` \ inst_env3 ->
addInstInfos inst_env3 generic_inst_info `thenNF_Tc` \ inst_env4 ->
-- note that we only do derivings for things in this module;
-- we ignore deriving decls from interfaces!
-- This stuff computes a context for the derived instance decl, so it
-- note that we only do derivings for things in this module;
-- 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
+ -- needs to know about all the instances possible; hence inst_env4
tcDeriving prs this_mod inst_env4 get_fixity tycl_decls
`thenTc` \ (deriv_inst_info, deriv_binds) ->
addInstInfos inst_env4 deriv_inst_info `thenNF_Tc` \ final_inst_env ->
tcDeriving prs this_mod inst_env4 get_fixity tycl_decls
`thenTc` \ (deriv_inst_info, deriv_binds) ->
addInstInfos inst_env4 deriv_inst_info `thenNF_Tc` \ final_inst_env ->
checkValidInstHead tau `thenTc_`
checkTc (checkInstFDs theta clas inst_tys)
(instTypeErr (pprClassPred clas inst_tys) msg) `thenTc_`
checkValidInstHead tau `thenTc_`
checkTc (checkInstFDs theta clas inst_tys)
(instTypeErr (pprClassPred clas inst_tys) msg) `thenTc_`
- newDFunName clas inst_tys src_loc
+ newDFunName clas inst_tys src_loc `thenTc` \ dfun_name ->
+ returnTc (mkDictFunId dfun_name clas tyvars inst_tys theta)
Just dfun_name -> -- An interface-file instance declaration
Just dfun_name -> -- An interface-file instance declaration
- returnNF_Tc dfun_name
- ) `thenNF_Tc` \ dfun_name ->
- let
- dfun_id = mkDictFunId dfun_name clas tyvars inst_tys theta
- in
+ -- Should be in scope by now, because we should
+ -- have sucked in its interface-file definition
+ -- So it will be replete with its unfolding etc
+ tcLookupId dfun_name
+ ) `thenNF_Tc` \ dfun_id ->
returnTc [InstInfo { iDFunId = dfun_id, iBinds = binds, iPrags = uprags }]
where
msg = parens (ptext SLIT("the instance types do not agree with the functional dependencies of the class"))
returnTc [InstInfo { iDFunId = dfun_id, iBinds = binds, iPrags = uprags }]
where
msg = parens (ptext SLIT("the instance types do not agree with the functional dependencies of the class"))
tcTyAndClassDecls unf_env this_mod tycl_decls `thenTc` \ env ->
tcSetEnv env $
tcTyAndClassDecls unf_env this_mod tycl_decls `thenTc` \ env ->
tcSetEnv env $
+ -- Interface type signatures
+ -- We tie a knot so that the Ids read out of interfaces are in scope
+ -- when we read their pragmas.
+ -- What we rely on is that pragmas are typechecked lazily; if
+ -- any type errors are found (ie there's an inconsistency)
+ -- we silently discard the pragma
+ traceTc (text "Tc2") `thenNF_Tc_`
+ tcInterfaceSigs unf_env this_mod tycl_decls `thenTc` \ sig_ids ->
+ tcExtendGlobalValEnv sig_ids $
+
-- Typecheck the instance decls, includes deriving
-- Typecheck the instance decls, includes deriving
- traceTc (text "Tc2") `thenNF_Tc_`
+ -- Note that imported dictionary functions are already
+ -- in scope from the preceding tcInterfaceSigs
+ traceTc (text "Tc3") `thenNF_Tc_`
tcInstDecls1 (pcs_insts pcs) (pcs_PRS pcs)
hst unf_env get_fixity this_mod
decls `thenTc` \ (new_pcs_insts, inst_env, local_insts, deriv_binds) ->
tcSetInstEnv inst_env $
tcInstDecls1 (pcs_insts pcs) (pcs_PRS pcs)
hst unf_env get_fixity this_mod
decls `thenTc` \ (new_pcs_insts, inst_env, local_insts, deriv_binds) ->
tcSetInstEnv inst_env $
- -- Interface type signatures
- -- We tie a knot so that the Ids read out of interfaces are in scope
- -- when we read their pragmas.
- -- What we rely on is that pragmas are typechecked lazily; if
- -- any type errors are found (ie there's an inconsistency)
- -- we silently discard the pragma
- traceTc (text "Tc3") `thenNF_Tc_`
- tcInterfaceSigs unf_env this_mod tycl_decls `thenTc` \ sig_ids ->
- tcExtendGlobalValEnv sig_ids $
-
-
tcIfaceRules unf_env (pcs_rules pcs) this_mod iface_rules `thenNF_Tc` \ (new_pcs_rules, local_rules) ->
-- When relinking this module from its interface-file decls
-- we'll have IfaceRules that are in fact local to this module
tcIfaceRules unf_env (pcs_rules pcs) this_mod iface_rules `thenNF_Tc` \ (new_pcs_rules, local_rules) ->
-- When relinking this module from its interface-file decls
-- we'll have IfaceRules that are in fact local to this module