import TcRnTypes
import TcRnMonad
import TcMonoType ( tcIfaceType, kcHsSigType )
-import TcEnv ( tcExtendTyVarEnv, tcExtendGlobalValEnv, tcLookupGlobalId )
+import TcEnv ( tcExtendTyVarEnv, tcExtendGlobalValEnv, tcLookupGlobalId,
+ tcLookupDataCon )
import RnHsSyn ( RenamedCoreDecl, RenamedTyClDecl )
import HsCore
import CoreLint ( lintUnfolding )
import WorkWrap ( mkWrapper )
-import Id ( Id, mkVanillaGlobal, mkLocalId, isDataConWrapId_maybe )
+import Id ( Id, mkVanillaGlobal, mkLocalId )
import MkId ( mkFCallId )
import IdInfo
import TyCon ( tyConDataCons, tyConTyVars )
import UniqSupply ( initUs_ )
import Outputable
import Util ( zipWithEqual, dropList, equalLength )
-import HscTypes ( TyThing(..), typeEnvIds )
+import HscTypes ( typeEnvIds )
import CmdLineOpts ( DynFlag(..) )
\end{code}
tcInterfaceSigs :: [RenamedTyClDecl] -- Ignore non-sig-decls in these decls
-> TcM TcGblEnv
-tcInterfaceSigs decls = fixM (tc_interface_sigs decls)
+-- May 2003:
+-- NOTE 1: careful about the side-effected EPS
+-- in the two tcExtendGlobalValueEnv calls
+-- NOTE 2: no point in tying the knot with fixM; all
+-- the important knot-tying comes via the PCS global variable
+
+tcInterfaceSigs decls =
+ zapEnv (fixM (tc_interface_sigs decls)) `thenM` \ (_,sig_ids) ->
+ -- The zapEnv dramatically trims the environment, solely
+ -- to plug the space leak that would otherwise be caused
+ -- by a rich environment bound into lots of lazy thunks
+ -- The thunks are the lazily-typechecked IdInfo of the
+ -- imported things.
+
+ tcExtendGlobalValEnv sig_ids getGblEnv `thenM` \ gbl_env ->
+ returnM gbl_env
-- 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
-- bound in this module (and hence not yet processed).
-- The discarding happens when forkM finds a type error.
-tc_interface_sigs decls unf_env
+tc_interface_sigs decls ~(unf_env, _)
= sequenceM [do_one d | d@(IfaceSig {}) <- decls] `thenM` \ sig_ids ->
- tcExtendGlobalValEnv sig_ids getGblEnv
- -- Return the extended environment
+ tcExtendGlobalValEnv sig_ids getGblEnv `thenM` \ gbl_env ->
+ returnM (gbl_env, sig_ids)
where
in_scope_vars = typeEnvIds (tcg_type_env unf_env)
-- When we have hi-boot files, an unfolding might refer to
where
-- Set the CgInfo to something sensible but uninformative before
-- we start; default assumption is that it has CAFs
- init_info = hasCafIdInfo
+ init_info = vanillaIdInfo
tcPrag info HsNoCafRefs = returnM (info `setCafInfo` NoCafRefs)
tcPrag info (HsArity arity) = returnM (info `setArityInfo` arity)
tcConAlt (UfTupleAlt (HsTupCon boxity arity))
= returnM (tupleCon boxity arity)
-tcConAlt (UfDataAlt con_name)
- = tcVar con_name `thenM` \ con_id ->
- returnM (case isDataConWrapId_maybe con_id of
- Just con -> con
- Nothing -> pprPanic "tcCoreAlt" (ppr con_id))
+tcConAlt (UfDataAlt con_name) -- When reading interface files
+ -- the con_name will be the real name of
+ -- the data con
+ = tcLookupDataCon con_name
\end{code}
%************************************************************************