Commit 1fdd97b6 authored by simonpj's avatar simonpj

[project @ 2001-11-26 10:26:59 by simonpj]

--------------------------------------
	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.
parent 0760818e
......@@ -17,7 +17,7 @@ module HsDecls (
hsDeclName, instDeclName,
tyClDeclName, tyClDeclNames, tyClDeclSysNames, tyClDeclTyVars,
isClassDecl, isSynDecl, isDataDecl, isIfaceSigDecl, countTyClDecls,
mkClassDeclSysNames, isIfaceRuleDecl, ifaceRuleDeclName,
mkClassDeclSysNames, isIfaceRuleDecl, isIfaceInstDecl, ifaceRuleDeclName,
getClassDeclSysNames, conDetailsTys,
collectRuleBndrSigTys
) where
......@@ -47,7 +47,7 @@ import Util ( eqListBy, count )
import SrcLoc ( SrcLoc )
import FastString
import Maybe ( isNothing, fromJust )
import Maybe ( isNothing, isJust, fromJust )
\end{code}
......@@ -661,6 +661,9 @@ data InstDecl name pat
-- Nothing for source-file instance decls
SrcLoc
isIfaceInstDecl :: InstDecl name pat -> Bool
isIfaceInstDecl (InstDecl _ _ _ maybe_dfun _) = isJust maybe_dfun
\end{code}
\begin{code}
......
......@@ -13,7 +13,8 @@ import CmdLineOpts ( DynFlag(..) )
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,
......@@ -34,7 +35,7 @@ import Inst ( InstOrigin(..),
LIE, mkLIE, emptyLIE, plusLIE, plusLIEs )
import TcDeriv ( tcDeriving )
import TcEnv ( TcEnv, tcExtendGlobalValEnv,
tcExtendTyVarEnvForMeths,
tcExtendTyVarEnvForMeths, tcLookupId,
tcAddImportedIdInfo, tcLookupClass,
InstInfo(..), pprInstInfo, simpleInstInfoTyCon,
simpleInstInfoTy, newDFunName,
......@@ -176,9 +177,11 @@ tcInstDecls1 inst_env0 prs hst unf_env get_fixity this_mod 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
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 ->
......@@ -191,17 +194,14 @@ tcInstDecls1 inst_env0 prs hst unf_env get_fixity this_mod decls
-- 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]) $
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 ->
......@@ -210,7 +210,7 @@ tcInstDecls1 inst_env0 prs hst unf_env get_fixity this_mod decls
-- 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 ->
......@@ -266,14 +266,15 @@ tcInstDecl1 decl@(InstDecl poly_ty binds uprags maybe_dfun_name src_loc)
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
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"))
......
......@@ -553,24 +553,25 @@ tcImports unf_env pcs hst get_fixity this_mod decls
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
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 $
-- 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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment