import RnSource ( rnSrcDecls, rnTyClDecls, checkModDeprec )
import PprCore ( pprIdRules, pprCoreBindings )
import CoreSyn ( IdCoreRule, bindersOfBinds )
import RnSource ( rnSrcDecls, rnTyClDecls, checkModDeprec )
import PprCore ( pprIdRules, pprCoreBindings )
import CoreSyn ( IdCoreRule, bindersOfBinds )
import ErrUtils ( Messages, mkDumpDoc, showPass )
import Id ( mkExportedLocalId, isLocalId, idName, idType )
import Var ( Var )
import ErrUtils ( Messages, mkDumpDoc, showPass )
import Id ( mkExportedLocalId, isLocalId, idName, idType )
import Var ( Var )
import TcHsType ( kcHsType )
import TcExpr ( tcCheckRho )
import TcIface ( loadImportedInsts )
import TcHsType ( kcHsType )
import TcExpr ( tcCheckRho )
import TcIface ( loadImportedInsts )
import TcUnify ( unifyTyConApp )
import TcMatches ( tcStmtsAndThen, TcStmtCtxt(..) )
import TcSimplify ( tcSimplifyInteractive, tcSimplifyInfer )
import TcUnify ( unifyTyConApp )
import TcMatches ( tcStmtsAndThen, TcStmtCtxt(..) )
import TcSimplify ( tcSimplifyInteractive, tcSimplifyInfer )
do { -- Deal with imports; sets tcg_rdr_env, tcg_imports
(rdr_env, imports) <- rnImports import_decls ;
do { -- Deal with imports; sets tcg_rdr_env, tcg_imports
(rdr_env, imports) <- rnImports import_decls ;
- -- In one-shot mode, record boot-file info in the EPS
- ifM (isOneShot (hsc_mode hsc_env)) $
- updateEps_ (\eps -> eps { eps_is_boot = imp_dep_mods imports }) ;
+ -- Record boot-file info in the EPS, so that it's
+ -- visible to loadHiBootInterface in tcRnSrcDecls,
+ -- and any other incrementally-performed imports
+ updateEps_ (\eps -> eps { eps_is_boot = imp_dep_mods imports }) ;
-- tcSimplifyTop deals with constant or ambiguous InstIds.
-- How could there be ambiguous ones? They can only arise if a
-- tcSimplifyTop deals with constant or ambiguous InstIds.
-- How could there be ambiguous ones? They can only arise if a
let { final_type_env = extendTypeEnvWithIds type_env bind_ids } ;
-- Compre the hi-boot iface (if any) with the real thing
let { final_type_env = extendTypeEnvWithIds type_env bind_ids } ;
-- Compre the hi-boot iface (if any) with the real thing
-- Make the new type env available to stuff slurped from interface files
writeMutVar (tcg_type_env_var tcg_env) final_type_env ;
-- Make the new type env available to stuff slurped from interface files
writeMutVar (tcg_type_env_var tcg_env) final_type_env ;
-- Loops around dealing with each top level inter-splice group
-- in turn, until it's dealt with the entire module
-- Loops around dealing with each top level inter-splice group
-- in turn, until it's dealt with the entire module
= do { let { (first_group, group_tail) = findSplice ds } ;
-- If ds is [] we get ([], Nothing)
-- Type check the decls up to, but not including, the first splice
= do { let { (first_group, group_tail) = findSplice ds } ;
-- If ds is [] we get ([], Nothing)
-- Type check the decls up to, but not including, the first splice
-- Bale out if errors; for example, error recovery when checking
-- the RHS of 'main' can mean that 'main' is not in the envt for
-- Bale out if errors; for example, error recovery when checking
-- the RHS of 'main' can mean that 'main' is not in the envt for
-- Glue them on the front of the remaining decls and loop
setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $
-- Glue them on the front of the remaining decls and loop
setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $
-- Compare the hi-boot file for this module (if there is one)
-- with the type environment we've just come up with
-- Compare the hi-boot file for this module (if there is one)
-- with the type environment we've just come up with
-checkHiBootIface env Nothing -- No hi-boot
- = return ()
+-- In the common case where there is no hi-boot file, the list
+-- of boot_names is empty.
+checkHiBootIface env boot_names
+ = mapM_ (check_one env) boot_names
-checkHiBootIface env (Just iface)
- = mapM_ (check_one env) exports
- where
- exports = [ (mod, availName avail) | (mod,avails) <- mi_exports iface,
- avail <- avails]
check_thing boot_thing real_thing -- Default case; failure
= addErrAt (srcLocSpan (getSrcLoc real_thing))
(bootMisMatch real_thing)
check_thing boot_thing real_thing -- Default case; failure
= addErrAt (srcLocSpan (getSrcLoc real_thing))
(bootMisMatch real_thing)
= do { -- Rename the declarations
(tcg_env, rn_decls) <- rnTopSrcDecls decls ;
setGblEnv tcg_env $ do {
-- Typecheck the declarations
= do { -- Rename the declarations
(tcg_env, rn_decls) <- rnTopSrcDecls decls ;
setGblEnv tcg_env $ do {
-- Typecheck the declarations
(HsGroup { hs_tyclds = tycl_decls,
hs_instds = inst_decls,
hs_fords = foreign_decls,
(HsGroup { hs_tyclds = tycl_decls,
hs_instds = inst_decls,
hs_fords = foreign_decls,
-- tcTyAndClassDecls recovers internally, but if anything gave rise to
-- an error we'd better stop now, to avoid a cascade
-- tcTyAndClassDecls recovers internally, but if anything gave rise to
-- an error we'd better stop now, to avoid a cascade
((tc_expr, res_ty), lie) <- getLIE (tcInferRho rn_expr) ;
((qtvs, _, dict_ids), lie_top) <- getLIE (tcSimplifyInfer smpl_doc (tyVarsOfType res_ty) lie) ;
tcSimplifyInteractive lie_top ;
((tc_expr, res_ty), lie) <- getLIE (tcInferRho rn_expr) ;
((qtvs, _, dict_ids), lie_top) <- getLIE (tcSimplifyInfer smpl_doc (tyVarsOfType res_ty) lie) ;
tcSimplifyInteractive lie_top ;