Commit 1c9f0be1 authored by simonpj's avatar simonpj
Browse files

[project @ 2003-10-16 10:19:27 by simonpj]

When type-checking an interface in --make, when the source file hasn't
changed, we must bring into scope all the things defined in the interface.
This was breaking --make badly.

The epicentre here is TcIface.typecheckIface
parent 3318172e
......@@ -296,7 +296,7 @@ tcIfaceGlobal name
}}}
tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
tcIfaceTyCon IfaceIntTc = return intTyCon
tcIfaceTyCon IfaceIntTc = return intTyCon
tcIfaceTyCon IfaceBoolTc = return boolTyCon
tcIfaceTyCon IfaceCharTc = return charTyCon
tcIfaceTyCon IfaceListTc = return listTyCon
......@@ -362,24 +362,6 @@ extendIfaceTyVarEnv tyvars thing_inside
%* *
%************************************************************************
IfaceDecls etc are populated with RdrNames. The RdrNames may either be
Orig or Unqual when the interface is read from a file
Exact when the interface is kept by GHCi, and is now
being re-linked with the type environment
At an occurrence site, to convert the RdrName to Name:
Unqual look up in LocalRdrEnv
Orig look up in OrigNameCache
Exact return the Name
At a binding site, to bind the RdrName
Unqual we extend the LocalRdrEnv
Orig or Unqual we don't extend the LocalRdrEnv (no need)
First, we deal with the RdrName -> Name mapping
\begin{code}
lookupIfaceTc :: IfaceTyCon -> IfL Name
lookupIfaceTc (IfaceTc ext) = lookupIfaceExt ext
......
......@@ -32,6 +32,7 @@ import HscTypes ( ExternalPackageState(..), PackageInstEnv, PackageRuleBase,
DeclPool, RulePool, Pool(..), Gated, addRuleToPool )
import InstEnv ( extendInstEnv )
import CoreSyn
import PprType ( pprClassPred )
import PprCore ( pprIdRules )
import Rules ( extendRuleBaseList )
import CoreUtils ( exprType )
......@@ -58,7 +59,7 @@ import Module ( Module, ModuleName, moduleName )
import UniqSupply ( initUs_ )
import Outputable
import SrcLoc ( noSrcLoc )
import Util ( zipWithEqual, dropList, equalLength )
import Util ( zipWithEqual, dropList, equalLength, zipLazy )
import Maybes ( expectJust )
import CmdLineOpts ( DynFlag(..) )
\end{code}
......@@ -208,22 +209,50 @@ selectDecl (Pool decls_map n_in n_out) name
%************************************************************************
%* *
Other interfaces
Type-checking a complete interface
%* *
%************************************************************************
Suppose we discover we don't need to recompile. Then we must type
check the old interface file. This is a bit different to the
incremental type checking we do as we suck in interface files. Instead
we do things similarly as when we are typechecking source decls: we
bring into scope the type envt for the interface all at once, using a
knot. Remember, the decls aren't necessarily in dependency order --
and even if they were, the type decls might be mutually recursive.
\begin{code}
typecheckIface :: ModIface -> IfG ModDetails
-- Used when we decide not to recompile, but intead to use the
-- interface to construct the type environment for the module
typecheckIface iface
= initIfaceLcl (moduleName (mi_module iface)) $
do { ty_things <- mapM (tcIfaceDecl . snd) (mi_decls iface)
; rules <- mapM tcIfaceRule (mi_rules iface)
typecheckIface :: HscEnv
-> ModIface -- Get the decls from here
-> IO ModDetails
typecheckIface hsc_env iface@(ModIface { mi_module = mod, mi_decls = ver_decls,
mi_rules = rules, mi_insts = dfuns })
= initIfaceTc hsc_env iface $ \ tc_env_var -> do
{ -- Typecheck the decls
names <- mappM (lookupOrig (moduleName mod) . ifName) decls
; ty_things <- fixM (\ rec_ty_things -> do
{ writeMutVar tc_env_var (mkNameEnv (names `zipLazy` rec_ty_things))
-- This only makes available the "main" things,
-- but that's enough for the strictly-checked part
; mapM tcIfaceDecl decls })
-- Now augment the type envt with all the implicit things
-- These will be needed when type-checking the unfoldings for
-- the IfaceIds, but this is done lazily, so writing the thing
-- now is sufficient
; let { add_implicits main_thing = main_thing : implicitTyThings main_thing
; type_env = mkTypeEnv (concatMap add_implicits ty_things) }
; writeMutVar tc_env_var type_env
-- Now do those rules and instances
; dfuns <- mapM tcIfaceInst (mi_insts iface)
; return (ModDetails { md_types = mkTypeEnv ty_things,
md_insts = dfuns,
md_rules = rules }) }
; rules <- mapM tcIfaceRule (mi_rules iface)
-- Finished
; return (ModDetails { md_types = type_env, md_insts = dfuns, md_rules = rules })
}
where
decls = map snd ver_decls
\end{code}
......@@ -441,6 +470,9 @@ loadImportedInsts cls tys
else do
{ writeMutVar eps_var (eps {eps_insts = inst_pool'})
; traceIf (sep [ptext SLIT("Importing instances for") <+> pprClassPred cls tys,
nest 2 (vcat (map ppr iface_insts))])
-- Typecheck the new instances
; dfuns <- initIfaceTcRn (mappM tc_inst iface_insts)
......
......@@ -42,7 +42,8 @@ import StringBuffer ( hGetStringBuffer )
import Parser
import Lexer ( P(..), ParseResult(..), mkPState, showPFailed )
import SrcLoc ( mkSrcLoc )
import TcRnDriver ( tcRnModule, tcRnExtCore, tcRnIface )
import TcRnDriver ( tcRnModule, tcRnExtCore )
import TcIface ( typecheckIface )
import IfaceEnv ( initNameCache )
import LoadIface ( ifaceStats, initExternalPackageState )
import PrelInfo ( wiredInThings, basicKnownKeyNames )
......@@ -182,7 +183,7 @@ hscNoRecomp hsc_env have_object
showModMsg have_object mod location);
new_details <- _scc_ "tcRnIface"
tcRnIface hsc_env old_iface ;
typecheckIface hsc_env old_iface ;
dumpIfaceStats hsc_env ;
return (HscNoRecomp new_details old_iface)
......
......@@ -10,7 +10,7 @@ module TcRnDriver (
#endif
tcRnModule,
tcTopSrcDecls,
tcRnIface, tcRnExtCore
tcRnExtCore
) where
#include "HsVersions.h"
......@@ -42,7 +42,7 @@ import TcEnv ( tcExtendGlobalValEnv, tcLookupGlobal )
import TcRules ( tcRules )
import TcForeign ( tcForeignImports, tcForeignExports )
import TcInstDcls ( tcInstDecls1, tcInstDecls2 )
import TcIface ( typecheckIface, tcExtCoreBindings )
import TcIface ( tcExtCoreBindings )
import TcSimplify ( tcSimplifyTop )
import TcTyClsDecls ( tcTyAndClassDecls )
import LoadIface ( loadOrphanModules )
......@@ -199,24 +199,6 @@ tcRnModule hsc_env
\end{code}
%*********************************************************
%* *
\subsection{Closing up the interface decls}
%* *
%*********************************************************
Suppose we discover we don't need to recompile. Then we start from the
IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
\begin{code}
tcRnIface :: HscEnv
-> ModIface -- Get the decls from here
-> IO ModDetails
tcRnIface hsc_env iface
= initIfaceTc hsc_env iface (typecheckIface iface)
\end{code}
%************************************************************************
%* *
The interactive interface
......
......@@ -12,7 +12,7 @@ import IOEnv -- Re-export all
import HsSyn ( MonoBinds(..) )
import HscTypes ( HscEnv(..), ModGuts(..), ModIface(..),
TyThing, Dependencies(..),
TyThing, Dependencies(..), TypeEnv, emptyTypeEnv,
ExternalPackageState(..), HomePackageTable,
ModDetails(..), HomeModInfo(..),
Deprecs(..), FixityEnv, FixItem,
......@@ -754,15 +754,22 @@ initIfaceCheck hsc_env do_this
; initTcRnIf 'i' hsc_env gbl_env () do_this
}
initIfaceTc :: HscEnv -> ModIface -> IfG a -> IO a
initIfaceTc :: HscEnv -> ModIface
-> (TcRef TypeEnv -> IfL a) -> IO a
-- Used when type-checking checking an up-to-date interface file
-- No type envt from the current module, but we do know the module dependencies
initIfaceTc hsc_env iface do_this
= do { let { gbl_env = IfGblEnv { if_is_boot = mkModDeps (dep_mods (mi_deps iface)),
if_rec_types = Nothing } ;
= do { tc_env_var <- newIORef emptyTypeEnv
; let { gbl_env = IfGblEnv { if_is_boot = mkModDeps (dep_mods (mi_deps iface)),
if_rec_types = Just (mod, readMutVar tc_env_var) } ;
; if_lenv = IfLclEnv { if_mod = moduleName mod,
if_tv_env = emptyOccEnv,
if_id_env = emptyOccEnv }
}
; initTcRnIf 'i' hsc_env gbl_env () do_this
; initTcRnIf 'i' hsc_env gbl_env if_lenv (do_this tc_env_var)
}
where
mod = mi_module iface
initIfaceRules :: HscEnv -> ModGuts -> IfG a -> IO a
-- Used when sucking in new Rules in SimplCore
......
......@@ -289,7 +289,7 @@ tcTyClDecl calc_vrcs calc_isrec decl
= tcAddDeclCtxt decl (tcTyClDecl1 calc_vrcs calc_isrec decl)
tcTyClDecl1 calc_vrcs calc_isrec
(TySynonym {tcdName = tc_name, tcdTyVars = tvs, tcdSynRhs = rhs_ty})
(TySynonym {tcdName = tc_name, tcdTyVars = tvs, tcdSynRhs = rhs_ty})
= tcTyVarBndrs tvs $ \ tvs' -> do
{ rhs_ty' <- tcHsKindedType rhs_ty
; return (ATyCon (buildSynTyCon tc_name tvs' rhs_ty' arg_vrcs)) }
......@@ -297,8 +297,8 @@ tcTyClDecl1 calc_vrcs calc_isrec
arg_vrcs = calc_vrcs tc_name
tcTyClDecl1 calc_vrcs calc_isrec
(TyData {tcdND = new_or_data, tcdCtxt = ctxt, tcdTyVars = tvs,
tcdName = tc_name, tcdCons = cons})
(TyData {tcdND = new_or_data, tcdCtxt = ctxt, tcdTyVars = tvs,
tcdName = tc_name, tcdCons = cons})
= tcTyVarBndrs tvs $ \ tvs' -> do
{ ctxt' <- tcHsKindedContext ctxt
; want_generic <- doptM Opt_Generics
......@@ -315,9 +315,9 @@ tcTyClDecl1 calc_vrcs calc_isrec
is_rec = calc_isrec tc_name
tcTyClDecl1 calc_vrcs calc_isrec
(ClassDecl {tcdName = class_name, tcdTyVars = tvs,
tcdCtxt = ctxt, tcdMeths = meths,
tcdFDs = fundeps, tcdSigs = sigs} )
(ClassDecl {tcdName = class_name, tcdTyVars = tvs,
tcdCtxt = ctxt, tcdMeths = meths,
tcdFDs = fundeps, tcdSigs = sigs} )
= tcTyVarBndrs tvs $ \ tvs' -> do
{ ctxt' <- tcHsKindedContext ctxt
; fds' <- mappM tc_fundep fundeps
......@@ -340,7 +340,7 @@ tcTyClDecl1 calc_vrcs calc_isrec
tcTyClDecl1 calc_vrcs calc_isrec
(ForeignType {tcdName = tc_name, tcdExtName = tc_ext_name})
(ForeignType {tcdName = tc_name, tcdExtName = tc_ext_name})
= returnM (ATyCon (mkForeignTyCon tc_name tc_ext_name liftedTypeKind 0 []))
-----------------------------------
......
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