Commit 3c44a46b authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Refactor self-boot info

This patch is a simple refactoring that prepares for a later one,
related to Trac #10083.

* Add a field tcg_self_boot :: SelfBootInfo to TcGblEnv,
  where SelfBootInfo is a new data type, describing the
  hi-boot file, if any, for the module being compiled.

* Make tcHiBootIface return SelfBootInfo, a new data type

* Make other functions get SelfBootInfo from the monad.

* Remove tcg_mod_name from TcGblEnv; it was barely used and
  simpler to pass around explicitly.
parent cd48797a
...@@ -165,13 +165,13 @@ typecheckIface iface ...@@ -165,13 +165,13 @@ typecheckIface iface
************************************************************************ ************************************************************************
-} -}
tcHiBootIface :: HscSource -> Module -> TcRn ModDetails tcHiBootIface :: HscSource -> Module -> TcRn SelfBootInfo
-- Load the hi-boot iface for the module being compiled, -- Load the hi-boot iface for the module being compiled,
-- if it indeed exists in the transitive closure of imports -- if it indeed exists in the transitive closure of imports
-- Return the ModDetails, empty if no hi-boot iface -- Return the ModDetails; Nothing if no hi-boot iface
tcHiBootIface hsc_src mod tcHiBootIface hsc_src mod
| HsBootFile <- hsc_src -- Already compiling a hs-boot file | HsBootFile <- hsc_src -- Already compiling a hs-boot file
= return emptyModDetails = return NoSelfBoot
| otherwise | otherwise
= do { traceIf (text "loadHiBootInterface" <+> ppr mod) = do { traceIf (text "loadHiBootInterface" <+> ppr mod)
...@@ -188,10 +188,10 @@ tcHiBootIface hsc_src mod ...@@ -188,10 +188,10 @@ tcHiBootIface hsc_src mod
-- And that's fine, because if M's ModInfo is in the HPT, then -- And that's fine, because if M's ModInfo is in the HPT, then
-- it's been compiled once, and we don't need to check the boot iface -- it's been compiled once, and we don't need to check the boot iface
then do { hpt <- getHpt then do { hpt <- getHpt
; case lookupUFM hpt (moduleName mod) of ; case lookupUFM hpt (moduleName mod) of
Just info | mi_boot (hm_iface info) Just info | mi_boot (hm_iface info)
-> return (hm_details info) -> return (mkSelfBootInfo (hm_details info))
_ -> return emptyModDetails } _ -> return NoSelfBoot }
else do else do
-- OK, so we're in one-shot mode. -- OK, so we're in one-shot mode.
...@@ -203,8 +203,9 @@ tcHiBootIface hsc_src mod ...@@ -203,8 +203,9 @@ tcHiBootIface hsc_src mod
True -- Hi-boot file True -- Hi-boot file
; case read_result of { ; case read_result of {
Succeeded (iface, _path) -> typecheckIface iface ; Succeeded (iface, _path) -> do { tc_iface <- typecheckIface iface
Failed err -> ; return (mkSelfBootInfo tc_iface) } ;
Failed err ->
-- There was no hi-boot file. But if there is circularity in -- There was no hi-boot file. But if there is circularity in
-- the module graph, there really should have been one. -- the module graph, there really should have been one.
...@@ -215,7 +216,7 @@ tcHiBootIface hsc_src mod ...@@ -215,7 +216,7 @@ tcHiBootIface hsc_src mod
-- disappeared. -- disappeared.
do { eps <- getEps do { eps <- getEps
; case lookupUFM (eps_is_boot eps) (moduleName mod) of ; case lookupUFM (eps_is_boot eps) (moduleName mod) of
Nothing -> return emptyModDetails -- The typical case Nothing -> return NoSelfBoot -- The typical case
Just (_, False) -> failWithTc moduleLoop Just (_, False) -> failWithTc moduleLoop
-- Someone below us imported us! -- Someone below us imported us!
...@@ -234,6 +235,15 @@ tcHiBootIface hsc_src mod ...@@ -234,6 +235,15 @@ tcHiBootIface hsc_src mod
elaborate err = hang (ptext (sLit "Could not find hi-boot interface for") <+> elaborate err = hang (ptext (sLit "Could not find hi-boot interface for") <+>
quotes (ppr mod) <> colon) 4 err quotes (ppr mod) <> colon) 4 err
mkSelfBootInfo :: ModDetails -> SelfBootInfo
mkSelfBootInfo mds
= SelfBoot { sb_mds = mds
, sb_tcs = mkNameSet (map tyConName (typeEnvTyCons iface_env))
, sb_ids = mkNameSet (map idName (typeEnvIds iface_env)) }
where
iface_env = md_types mds
{- {-
************************************************************************ ************************************************************************
* * * *
......
...@@ -43,7 +43,6 @@ import DynFlags ...@@ -43,7 +43,6 @@ import DynFlags
import HscTypes ( HscEnv, hsc_dflags ) import HscTypes ( HscEnv, hsc_dflags )
import ListSetOps ( findDupsEq, removeDups ) import ListSetOps ( findDupsEq, removeDups )
import Digraph ( SCC, flattenSCC, stronglyConnCompFromEdgedVertices ) import Digraph ( SCC, flattenSCC, stronglyConnCompFromEdgedVertices )
import Util ( mapSnd )
import Control.Monad import Control.Monad
import Data.List( partition, sortBy ) import Data.List( partition, sortBy )
...@@ -71,21 +70,21 @@ Checks the @(..)@ etc constraints in the export list. ...@@ -71,21 +70,21 @@ Checks the @(..)@ etc constraints in the export list.
-- Brings the binders of the group into scope in the appropriate places; -- Brings the binders of the group into scope in the appropriate places;
-- does NOT assume that anything is in scope already -- does NOT assume that anything is in scope already
rnSrcDecls :: Maybe FreeVars -> HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name) rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
-- Rename a top-level HsGroup; used for normal source files *and* hs-boot files -- Rename a top-level HsGroup; used for normal source files *and* hs-boot files
rnSrcDecls extra_deps group@(HsGroup { hs_valds = val_decls, rnSrcDecls group@(HsGroup { hs_valds = val_decls,
hs_splcds = splice_decls, hs_splcds = splice_decls,
hs_tyclds = tycl_decls, hs_tyclds = tycl_decls,
hs_instds = inst_decls, hs_instds = inst_decls,
hs_derivds = deriv_decls, hs_derivds = deriv_decls,
hs_fixds = fix_decls, hs_fixds = fix_decls,
hs_warnds = warn_decls, hs_warnds = warn_decls,
hs_annds = ann_decls, hs_annds = ann_decls,
hs_fords = foreign_decls, hs_fords = foreign_decls,
hs_defds = default_decls, hs_defds = default_decls,
hs_ruleds = rule_decls, hs_ruleds = rule_decls,
hs_vects = vect_decls, hs_vects = vect_decls,
hs_docs = docs }) hs_docs = docs })
= do { = do {
-- (A) Process the fixity declarations, creating a mapping from -- (A) Process the fixity declarations, creating a mapping from
-- FastStrings to FixItems. -- FastStrings to FixItems.
...@@ -147,7 +146,7 @@ rnSrcDecls extra_deps group@(HsGroup { hs_valds = val_decls, ...@@ -147,7 +146,7 @@ rnSrcDecls extra_deps group@(HsGroup { hs_valds = val_decls,
-- means we'll only report a declaration as unused if it isn't -- means we'll only report a declaration as unused if it isn't
-- mentioned at all. Ah well. -- mentioned at all. Ah well.
traceRn (text "Start rnTyClDecls") ; traceRn (text "Start rnTyClDecls") ;
(rn_tycl_decls, src_fvs1) <- rnTyClDecls extra_deps tycl_decls ; (rn_tycl_decls, src_fvs1) <- rnTyClDecls tycl_decls ;
-- (F) Rename Value declarations right-hand sides -- (F) Rename Value declarations right-hand sides
traceRn (text "Start rnmono") ; traceRn (text "Start rnmono") ;
...@@ -930,7 +929,7 @@ doing dependency analysis when compiling A.hs ...@@ -930,7 +929,7 @@ doing dependency analysis when compiling A.hs
To handle this problem, we add a dependency To handle this problem, we add a dependency
- from every local declaration - from every local declaration
- to everything that comes from this module's .hs-boot file. - to everything that comes from this module's .hs-boot file.
In this case, we'll add and edges In this case, we'll ad and edges
- from A2 to A1 (but that edge is there already) - from A2 to A1 (but that edge is there already)
- from A1 to A1 (which is new) - from A1 to A1 (which is new)
...@@ -949,26 +948,35 @@ See also Note [Grouping of type and class declarations] in TcTyClsDecls. ...@@ -949,26 +948,35 @@ See also Note [Grouping of type and class declarations] in TcTyClsDecls.
-} -}
rnTyClDecls :: Maybe FreeVars -> [TyClGroup RdrName] rnTyClDecls :: [TyClGroup RdrName]
-> RnM ([TyClGroup Name], FreeVars) -> RnM ([TyClGroup Name], FreeVars)
-- Rename the declarations and do depedency analysis on them -- Rename the declarations and do depedency analysis on them
rnTyClDecls extra_deps tycl_ds rnTyClDecls tycl_ds
= do { ds_w_fvs <- mapM (wrapLocFstM rnTyClDecl) (tyClGroupConcat tycl_ds) = do { ds_w_fvs <- mapM (wrapLocFstM rnTyClDecl) (tyClGroupConcat tycl_ds)
; let decl_names = mkNameSet (map (tcdName . unLoc . fst) ds_w_fvs) ; let decl_names = mkNameSet (map (tcdName . unLoc . fst) ds_w_fvs)
; role_annot_env <- rnRoleAnnots decl_names (concatMap group_roles tycl_ds) ; role_annot_env <- rnRoleAnnots decl_names (concatMap group_roles tycl_ds)
; this_mod <- getModule ; tcg_env <- getGblEnv
; let add_boot_deps :: FreeVars -> FreeVars ; let this_mod = tcg_mod tcg_env
boot_info = tcg_self_boot tcg_env
add_boot_deps :: [(LTyClDecl Name, FreeVars)] -> [(LTyClDecl Name, FreeVars)]
-- See Note [Extra dependencies from .hs-boot files] -- See Note [Extra dependencies from .hs-boot files]
add_boot_deps fvs add_boot_deps ds_w_fvs
| Just extra <- extra_deps = case boot_info of
, has_local_imports fvs = fvs `plusFV` extra SelfBoot { sb_tcs = tcs } | not (isEmptyNameSet tcs)
| otherwise = fvs -> map (add_one tcs) ds_w_fvs
_ -> ds_w_fvs
add_one :: NameSet -> (LTyClDecl Name, FreeVars) -> (LTyClDecl Name, FreeVars)
add_one tcs pr@(decl,fvs)
| has_local_imports fvs = (decl, fvs `plusFV` tcs)
| otherwise = pr
has_local_imports fvs has_local_imports fvs
= foldNameSet ((||) . nameIsHomePackageImport this_mod) = foldNameSet ((||) . nameIsHomePackageImport this_mod)
False fvs False fvs
ds_w_fvs' = mapSnd add_boot_deps ds_w_fvs ds_w_fvs' = add_boot_deps ds_w_fvs
sccs :: [SCC (LTyClDecl Name)] sccs :: [SCC (LTyClDecl Name)]
sccs = depAnalTyClDecls ds_w_fvs' sccs = depAnalTyClDecls ds_w_fvs'
......
...@@ -131,7 +131,7 @@ rn_bracket _ (DecBrL decls) ...@@ -131,7 +131,7 @@ rn_bracket _ (DecBrL decls)
-- The emptyDUs is so that we just collect uses for this -- The emptyDUs is so that we just collect uses for this
-- group alone in the call to rnSrcDecls below -- group alone in the call to rnSrcDecls below
; (tcg_env, group') <- setGblEnv new_gbl_env $ ; (tcg_env, group') <- setGblEnv new_gbl_env $
rnSrcDecls Nothing group rnSrcDecls group
-- Discard the tcg_env; it contains only extra info about fixity -- Discard the tcg_env; it contains only extra info about fixity
; traceRn (text "rn_bracket dec" <+> (ppr (tcg_dus tcg_env) $$ ; traceRn (text "rn_bracket dec" <+> (ppr (tcg_dus tcg_env) $$
......
...@@ -252,7 +252,7 @@ checkHsigIface' gr ...@@ -252,7 +252,7 @@ checkHsigIface' gr
-- In general, for hsig files we can't assume that the implementing -- In general, for hsig files we can't assume that the implementing
-- file actually implemented the instances (they may be reexported -- file actually implemented the instances (they may be reexported
-- from elsewhere. Where should we look for the instances? We do -- from elsewhere). Where should we look for the instances? We do
-- the same as we would otherwise: consult the EPS. This isn't -- the same as we would otherwise: consult the EPS. This isn't
-- perfect (we might conclude the module exports an instance -- perfect (we might conclude the module exports an instance
-- when it doesn't, see #9422), but we will never refuse to compile -- when it doesn't, see #9422), but we will never refuse to compile
...@@ -280,10 +280,22 @@ tcRnModuleTcRnM hsc_env hsc_src ...@@ -280,10 +280,22 @@ tcRnModuleTcRnM hsc_env hsc_src
}) })
(this_mod, prel_imp_loc) (this_mod, prel_imp_loc)
= setSrcSpan loc $ = setSrcSpan loc $
do { let { dflags = hsc_dflags hsc_env } ; do { let { dflags = hsc_dflags hsc_env
; explicit_mod_hdr = isJust maybe_mod } ;
tcg_env <- tcRnSignature dflags hsc_src ; tcg_env <- tcRnSignature dflags hsc_src ;
setGblEnv tcg_env { tcg_mod_name=maybe_mod } $ do { setGblEnv tcg_env $ do {
-- Load the hi-boot interface for this module, if any
-- We do this now so that the boot_names can be passed
-- to tcTyAndClassDecls, because the boot_names are
-- automatically considered to be loop breakers
--
-- Do this *after* tcRnImports, so that we know whether
-- a module that we import imports us; and hence whether to
-- look for a hi-boot file
boot_info <- tcHiBootIface hsc_src this_mod ;
setGblEnv (tcg_env { tcg_self_boot = boot_info }) $ do {
-- Deal with imports; first add implicit prelude -- Deal with imports; first add implicit prelude
implicit_prelude <- xoptM Opt_ImplicitPrelude; implicit_prelude <- xoptM Opt_ImplicitPrelude;
...@@ -306,28 +318,18 @@ tcRnModuleTcRnM hsc_env hsc_src ...@@ -306,28 +318,18 @@ tcRnModuleTcRnM hsc_env hsc_src
setGblEnv tcg_env1 $ do { setGblEnv tcg_env1 $ do {
-- Load the hi-boot interface for this module, if any
-- We do this now so that the boot_names can be passed
-- to tcTyAndClassDecls, because the boot_names are
-- automatically considered to be loop breakers
--
-- Do this *after* tcRnImports, so that we know whether
-- a module that we import imports us; and hence whether to
-- look for a hi-boot file
boot_iface <- tcHiBootIface hsc_src this_mod ;
-- Rename and type check the declarations -- Rename and type check the declarations
traceRn (text "rn1a") ; traceRn (text "rn1a") ;
tcg_env <- if isHsBootOrSig hsc_src then tcg_env <- if isHsBootOrSig hsc_src then
tcRnHsBootDecls hsc_src local_decls tcRnHsBootDecls hsc_src local_decls
else else
{-# SCC "tcRnSrcDecls" #-} {-# SCC "tcRnSrcDecls" #-}
tcRnSrcDecls boot_iface export_ies local_decls ; tcRnSrcDecls explicit_mod_hdr export_ies local_decls ;
setGblEnv tcg_env $ do { setGblEnv tcg_env $ do {
-- Process the export list -- Process the export list
traceRn (text "rn4a: before exports"); traceRn (text "rn4a: before exports");
tcg_env <- rnExports (isJust maybe_mod) export_ies tcg_env ; tcg_env <- rnExports explicit_mod_hdr export_ies tcg_env ;
traceRn (text "rn4b: after exports") ; traceRn (text "rn4b: after exports") ;
-- Check that main is exported (must be after rnExports) -- Check that main is exported (must be after rnExports)
...@@ -335,7 +337,7 @@ tcRnModuleTcRnM hsc_env hsc_src ...@@ -335,7 +337,7 @@ tcRnModuleTcRnM hsc_env hsc_src
-- Compare the hi-boot iface (if any) with the real thing -- Compare the hi-boot iface (if any) with the real thing
-- Must be done after processing the exports -- Must be done after processing the exports
tcg_env <- checkHiBootIface tcg_env boot_iface ; tcg_env <- checkHiBootIface tcg_env boot_info ;
-- Compare the hsig tcg_env with the real thing -- Compare the hsig tcg_env with the real thing
checkHsigIface hsc_env tcg_env ; checkHsigIface hsc_env tcg_env ;
...@@ -371,7 +373,7 @@ tcRnModuleTcRnM hsc_env hsc_src ...@@ -371,7 +373,7 @@ tcRnModuleTcRnM hsc_env hsc_src
-- Dump output and return -- Dump output and return
tcDump tcg_env ; tcDump tcg_env ;
return tcg_env return tcg_env
}}}} }}}}}
implicitPreludeWarn :: SDoc implicitPreludeWarn :: SDoc
implicitPreludeWarn implicitPreludeWarn
...@@ -455,20 +457,31 @@ tcRnImports hsc_env import_decls ...@@ -455,20 +457,31 @@ tcRnImports hsc_env import_decls
************************************************************************ ************************************************************************
-} -}
tcRnSrcDecls :: ModDetails tcRnSrcDecls :: Bool -- False => no 'module M(..) where' header at all
-> Maybe (Located [LIE RdrName]) -- Exports -> Maybe (Located [LIE RdrName]) -- Exports
-> [LHsDecl RdrName] -- Declarations -> [LHsDecl RdrName] -- Declarations
-> TcM TcGblEnv -> TcM TcGblEnv
-- Returns the variables free in the decls -- Returns the variables free in the decls
-- Reason: solely to report unused imports and bindings -- Reason: solely to report unused imports and bindings
tcRnSrcDecls boot_iface exports decls tcRnSrcDecls explicit_mod_hdr exports decls
= do { -- Do all the declarations = do { -- Do all the declarations
((tcg_env, tcl_env), lie) <- captureConstraints $ tc_rn_src_decls boot_iface decls ; ((tcg_env, tcl_env), lie) <- captureConstraints $
; traceTc "Tc8" empty ; do { (tcg_env, tcl_env) <- tc_rn_src_decls decls ;
; setEnvs (tcg_env, tcl_env) $ ; tcg_env <- setEnvs (tcg_env, tcl_env) $
do { checkMain explicit_mod_hdr
; return (tcg_env, tcl_env) }
; setEnvs (tcg_env, tcl_env) $ do {
#ifdef GHCI
-- Run all module finalizers
let th_modfinalizers_var = tcg_th_modfinalizers tcg_env
; modfinalizers <- readTcRef th_modfinalizers_var
; writeTcRef th_modfinalizers_var []
; mapM_ runQuasi modfinalizers
#endif /* GHCI */
-- wanted constraints from static forms -- wanted constraints from static forms
stWC <- tcg_static_wc <$> getGblEnv >>= readTcRef ; ; stWC <- tcg_static_wc <$> getGblEnv >>= readTcRef
-- Finish simplifying class constraints -- Finish simplifying class constraints
-- --
...@@ -484,18 +497,18 @@ tcRnSrcDecls boot_iface exports decls ...@@ -484,18 +497,18 @@ tcRnSrcDecls boot_iface exports decls
-- * the global env exposes the instances to simplifyTop -- * the global env exposes the instances to simplifyTop
-- * the local env exposes the local Ids to simplifyTop, -- * the local env exposes the local Ids to simplifyTop,
-- so that we get better error messages (monomorphism restriction) -- so that we get better error messages (monomorphism restriction)
new_ev_binds <- {-# SCC "simplifyTop" #-} ; new_ev_binds <- {-# SCC "simplifyTop" #-}
simplifyTop (andWC stWC lie) ; simplifyTop (andWC stWC lie)
traceTc "Tc9" empty ; ; traceTc "Tc9" empty
failIfErrsM ; -- Don't zonk if there have been errors ; failIfErrsM -- Don't zonk if there have been errors
-- It's a waste of time; and we may get debug warnings -- It's a waste of time; and we may get debug warnings
-- about strangely-typed TyCons! -- about strangely-typed TyCons!
-- Zonk the final code. This must be done last. -- Zonk the final code. This must be done last.
-- Even simplifyTop may do some unification. -- Even simplifyTop may do some unification.
-- This pass also warns about missing type signatures -- This pass also warns about missing type signatures
let { TcGblEnv { tcg_type_env = type_env, ; let { TcGblEnv { tcg_type_env = type_env,
tcg_binds = binds, tcg_binds = binds,
tcg_sigs = sig_ns, tcg_sigs = sig_ns,
tcg_ev_binds = cur_ev_binds, tcg_ev_binds = cur_ev_binds,
...@@ -505,12 +518,12 @@ tcRnSrcDecls boot_iface exports decls ...@@ -505,12 +518,12 @@ tcRnSrcDecls boot_iface exports decls
tcg_fords = fords } = tcg_env tcg_fords = fords } = tcg_env
; all_ev_binds = cur_ev_binds `unionBags` new_ev_binds } ; ; all_ev_binds = cur_ev_binds `unionBags` new_ev_binds } ;
(bind_ids, ev_binds', binds', fords', imp_specs', rules', vects') ; (bind_ids, ev_binds', binds', fords', imp_specs', rules', vects')
<- {-# SCC "zonkTopDecls" #-} <- {-# SCC "zonkTopDecls" #-}
zonkTopDecls all_ev_binds binds exports sig_ns rules vects zonkTopDecls all_ev_binds binds exports sig_ns rules vects
imp_specs fords ; imp_specs fords ;
let { final_type_env = extendTypeEnvWithIds type_env bind_ids ; let { final_type_env = extendTypeEnvWithIds type_env bind_ids
; tcg_env' = tcg_env { tcg_binds = binds', ; tcg_env' = tcg_env { tcg_binds = binds',
tcg_ev_binds = ev_binds', tcg_ev_binds = ev_binds',
tcg_imp_specs = imp_specs', tcg_imp_specs = imp_specs',
...@@ -518,28 +531,21 @@ tcRnSrcDecls boot_iface exports decls ...@@ -518,28 +531,21 @@ tcRnSrcDecls boot_iface exports decls
tcg_vects = vects', tcg_vects = vects',
tcg_fords = fords' } } ; tcg_fords = fords' } } ;
setGlobalTypeEnv tcg_env' final_type_env ; setGlobalTypeEnv tcg_env' final_type_env
} } } }
tc_rn_src_decls :: ModDetails tc_rn_src_decls :: [LHsDecl RdrName]
-> [LHsDecl RdrName]
-> TcM (TcGblEnv, TcLclEnv) -> TcM (TcGblEnv, TcLclEnv)
-- Loops around dealing with each top level inter-splice group -- Loops around dealing with each top level inter-splice group
-- in turn, until it's dealt with the entire module -- in turn, until it's dealt with the entire module
tc_rn_src_decls boot_details ds tc_rn_src_decls ds
= {-# SCC "tc_rn_src_decls" #-} = {-# SCC "tc_rn_src_decls" #-}
do { (first_group, group_tail) <- findSplice ds do { (first_group, group_tail) <- findSplice ds
-- If ds is [] we get ([], Nothing) -- If ds is [] we get ([], Nothing)
-- The extra_deps are needed while renaming type and class declarations
-- See Note [Extra dependencies from .hs-boot files] in RnSource
; let { tycons = typeEnvTyCons (md_types boot_details)
; extra_deps | null tycons = Nothing
| otherwise = Just (mkFVs (map tyConName tycons)) }
-- Deal with decls up to, but not including, the first splice -- Deal with decls up to, but not including, the first splice
; (tcg_env, rn_decls) <- rnTopSrcDecls extra_deps first_group ; (tcg_env, rn_decls) <- rnTopSrcDecls first_group
-- rnTopSrcDecls fails if there are any errors -- rnTopSrcDecls fails if there are any errors
#ifdef GHCI #ifdef GHCI
...@@ -562,7 +568,7 @@ tc_rn_src_decls boot_details ds ...@@ -562,7 +568,7 @@ tc_rn_src_decls boot_details ds
-- Rename TH-generated top-level declarations -- Rename TH-generated top-level declarations
; (tcg_env, th_rn_decls) <- setGblEnv tcg_env $ ; (tcg_env, th_rn_decls) <- setGblEnv tcg_env $
rnTopSrcDecls extra_deps th_group rnTopSrcDecls th_group
-- Dump generated top-level declarations -- Dump generated top-level declarations
; let msg = "top-level declarations added with addTopDecls" ; let msg = "top-level declarations added with addTopDecls"
...@@ -577,21 +583,12 @@ tc_rn_src_decls boot_details ds ...@@ -577,21 +583,12 @@ tc_rn_src_decls boot_details ds
-- Type check all declarations -- Type check all declarations
; (tcg_env, tcl_env) <- setGblEnv tcg_env $ ; (tcg_env, tcl_env) <- setGblEnv tcg_env $
tcTopSrcDecls boot_details rn_decls tcTopSrcDecls rn_decls
-- If there is no splice, we're nearly done -- If there is no splice, we're nearly done
; setEnvs (tcg_env, tcl_env) $ ; setEnvs (tcg_env, tcl_env) $
case group_tail of case group_tail of
{ Nothing -> do { tcg_env <- checkMain -- Check for `main' { Nothing -> return (tcg_env, tcl_env)
#ifdef GHCI
-- Run all module finalizers
; th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv
; modfinalizers <- readTcRef th_modfinalizers_var
; writeTcRef th_modfinalizers_var []
; mapM_ runQuasi modfinalizers
#endif /* GHCI */
; return (tcg_env, tcl_env)
}
#ifndef GHCI #ifndef GHCI
-- There shouldn't be a splice -- There shouldn't be a splice
...@@ -606,7 +603,7 @@ tc_rn_src_decls boot_details ds ...@@ -606,7 +603,7 @@ tc_rn_src_decls boot_details ds
-- Glue them on the front of the remaining decls and loop -- Glue them on the front of the remaining decls and loop
; setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $ ; setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $
tc_rn_src_decls boot_details (spliced_decls ++ rest_ds) tc_rn_src_decls (spliced_decls ++ rest_ds)
} }
} }
#endif /* GHCI */ #endif /* GHCI */
...@@ -635,7 +632,7 @@ tcRnHsBootDecls hsc_src decls ...@@ -635,7 +632,7 @@ tcRnHsBootDecls hsc_src decls
hs_ruleds = rule_decls, hs_ruleds = rule_decls,
hs_vects = vect_decls, hs_vects = vect_decls,
hs_annds = _, hs_annds = _,
hs_valds = val_binds }) <- rnTopSrcDecls Nothing first_group hs_valds = val_binds }) <- rnTopSrcDecls first_group
-- The empty list is for extra dependencies coming from .hs-boot files -- The empty list is for extra dependencies coming from .hs-boot files
-- See Note [Extra dependencies from .hs-boot files] in RnSource -- See Note [Extra dependencies from .hs-boot files] in RnSource
; (gbl_env, lie) <- captureConstraints $ setGblEnv tcg_env $ do { ; (gbl_env, lie) <- captureConstraints $ setGblEnv tcg_env $ do {
...@@ -653,7 +650,7 @@ tcRnHsBootDecls hsc_src decls ...@@ -653,7 +650,7 @@ tcRnHsBootDecls hsc_src decls
-- Typecheck type/class/isntance decls -- Typecheck type/class/isntance decls
; traceTc "Tc2 (boot)" empty ; traceTc "Tc2 (boot)" empty
; (tcg_env, inst_infos, _deriv_binds) ; (tcg_env, inst_infos, _deriv_binds)
<- tcTyClsInstDecls emptyModDetails tycl_decls inst_decls deriv_decls <- tcTyClsInstDecls tycl_decls inst_decls deriv_decls
; setGblEnv tcg_env $ do { ; setGblEnv tcg_env $ do {
-- Typecheck value declarations -- Typecheck value declarations
...@@ -696,22 +693,24 @@ Once we've typechecked the body of the module, we want to compare what ...@@ -696,22 +693,24 @@ Once we've typechecked the body of the module, we want to compare what
we've found (gathered in a TypeEnv) with the hi-boot details (if any). we've found (gathered in a TypeEnv) with the hi-boot details (if any).
-} -}
checkHiBootIface :: TcGblEnv -> ModDetails -> TcM TcGblEnv checkHiBootIface :: TcGblEnv -> SelfBootInfo -> TcM TcGblEnv
-- Compare the hi-boot file for this module (if there is one) -- Compare the hi-boot file for this module (if there is one)
-- with the type environment we've just come up with -- with the type environment we've just come up with
-- In the common case where there is no hi-boot file, the list -- In the common case where there is no hi-boot file, the list
-- of boot_names is empty. -- of boot_names is empty.
checkHiBootIface checkHiBootIface tcg_env boot_info
tcg_env@(TcGblEnv { tcg_src = hs_src, tcg_binds = binds | NoSelfBoot <- boot_info -- Common case
, tcg_insts = local_insts
, tcg_type_env = local_type_env