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
************************************************************************
-}
tcHiBootIface :: HscSource -> Module -> TcRn ModDetails
tcHiBootIface :: HscSource -> Module -> TcRn SelfBootInfo
-- Load the hi-boot iface for the module being compiled,
-- 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
| HsBootFile <- hsc_src -- Already compiling a hs-boot file
= return emptyModDetails
= return NoSelfBoot
| otherwise
= do { traceIf (text "loadHiBootInterface" <+> ppr mod)
......@@ -190,8 +190,8 @@ tcHiBootIface hsc_src mod
then do { hpt <- getHpt
; case lookupUFM hpt (moduleName mod) of
Just info | mi_boot (hm_iface info)
-> return (hm_details info)
_ -> return emptyModDetails }
-> return (mkSelfBootInfo (hm_details info))
_ -> return NoSelfBoot }
else do
-- OK, so we're in one-shot mode.
......@@ -203,7 +203,8 @@ tcHiBootIface hsc_src mod
True -- Hi-boot file
; case read_result of {
Succeeded (iface, _path) -> typecheckIface iface ;
Succeeded (iface, _path) -> do { tc_iface <- typecheckIface iface
; return (mkSelfBootInfo tc_iface) } ;
Failed err ->
-- There was no hi-boot file. But if there is circularity in
......@@ -215,7 +216,7 @@ tcHiBootIface hsc_src mod
-- disappeared.
do { eps <- getEps
; 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
-- Someone below us imported us!
......@@ -234,6 +235,15 @@ tcHiBootIface hsc_src mod
elaborate err = hang (ptext (sLit "Could not find hi-boot interface for") <+>
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
import HscTypes ( HscEnv, hsc_dflags )
import ListSetOps ( findDupsEq, removeDups )
import Digraph ( SCC, flattenSCC, stronglyConnCompFromEdgedVertices )
import Util ( mapSnd )
import Control.Monad
import Data.List( partition, sortBy )
......@@ -71,9 +70,9 @@ Checks the @(..)@ etc constraints in the export list.
-- Brings the binders of the group into scope in the appropriate places;
-- 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
rnSrcDecls extra_deps group@(HsGroup { hs_valds = val_decls,
rnSrcDecls group@(HsGroup { hs_valds = val_decls,
hs_splcds = splice_decls,
hs_tyclds = tycl_decls,
hs_instds = inst_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
-- mentioned at all. Ah well.
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
traceRn (text "Start rnmono") ;
......@@ -930,7 +929,7 @@ doing dependency analysis when compiling A.hs
To handle this problem, we add a dependency
- from every local declaration
- 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 A1 to A1 (which is new)
......@@ -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)
-- 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)
; let decl_names = mkNameSet (map (tcdName . unLoc . fst) ds_w_fvs)
; role_annot_env <- rnRoleAnnots decl_names (concatMap group_roles tycl_ds)
; this_mod <- getModule
; let add_boot_deps :: FreeVars -> FreeVars
; tcg_env <- getGblEnv
; 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]
add_boot_deps fvs
| Just extra <- extra_deps
, has_local_imports fvs = fvs `plusFV` extra
| otherwise = fvs
add_boot_deps ds_w_fvs
= case boot_info of
SelfBoot { sb_tcs = tcs } | not (isEmptyNameSet tcs)
-> 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
= foldNameSet ((||) . nameIsHomePackageImport this_mod)
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 = depAnalTyClDecls ds_w_fvs'
......
......@@ -131,7 +131,7 @@ rn_bracket _ (DecBrL decls)
-- The emptyDUs is so that we just collect uses for this
-- group alone in the call to rnSrcDecls below
; (tcg_env, group') <- setGblEnv new_gbl_env $
rnSrcDecls Nothing group
rnSrcDecls group
-- Discard the tcg_env; it contains only extra info about fixity
; traceRn (text "rn_bracket dec" <+> (ppr (tcg_dus tcg_env) $$
......
......@@ -252,7 +252,7 @@ checkHsigIface' gr
-- In general, for hsig files we can't assume that the implementing
-- 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
-- perfect (we might conclude the module exports an instance
-- when it doesn't, see #9422), but we will never refuse to compile
......@@ -280,10 +280,22 @@ tcRnModuleTcRnM hsc_env hsc_src
})
(this_mod, prel_imp_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 ;
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
implicit_prelude <- xoptM Opt_ImplicitPrelude;
......@@ -306,28 +318,18 @@ tcRnModuleTcRnM hsc_env hsc_src
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
traceRn (text "rn1a") ;
tcg_env <- if isHsBootOrSig hsc_src then
tcRnHsBootDecls hsc_src local_decls
else
{-# SCC "tcRnSrcDecls" #-}
tcRnSrcDecls boot_iface export_ies local_decls ;
tcRnSrcDecls explicit_mod_hdr export_ies local_decls ;
setGblEnv tcg_env $ do {
-- Process the export list
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") ;
-- Check that main is exported (must be after rnExports)
......@@ -335,7 +337,7 @@ tcRnModuleTcRnM hsc_env hsc_src
-- Compare the hi-boot iface (if any) with the real thing
-- 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
checkHsigIface hsc_env tcg_env ;
......@@ -371,7 +373,7 @@ tcRnModuleTcRnM hsc_env hsc_src
-- Dump output and return
tcDump tcg_env ;
return tcg_env
}}}}
}}}}}
implicitPreludeWarn :: SDoc
implicitPreludeWarn
......@@ -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
-> [LHsDecl RdrName] -- Declarations
-> TcM TcGblEnv
-- Returns the variables free in the decls
-- Reason: solely to report unused imports and bindings
tcRnSrcDecls boot_iface exports decls
tcRnSrcDecls explicit_mod_hdr exports decls
= do { -- Do all the declarations
((tcg_env, tcl_env), lie) <- captureConstraints $ tc_rn_src_decls boot_iface decls ;
; traceTc "Tc8" empty ;
; setEnvs (tcg_env, tcl_env) $
do {
((tcg_env, tcl_env), lie) <- captureConstraints $
do { (tcg_env, tcl_env) <- tc_rn_src_decls decls ;
; tcg_env <- setEnvs (tcg_env, tcl_env) $
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
stWC <- tcg_static_wc <$> getGblEnv >>= readTcRef ;
; stWC <- tcg_static_wc <$> getGblEnv >>= readTcRef
-- Finish simplifying class constraints
--
......@@ -484,18 +497,18 @@ tcRnSrcDecls boot_iface exports decls
-- * the global env exposes the instances to simplifyTop
-- * the local env exposes the local Ids to simplifyTop,
-- so that we get better error messages (monomorphism restriction)
new_ev_binds <- {-# SCC "simplifyTop" #-}
simplifyTop (andWC stWC lie) ;
traceTc "Tc9" empty ;
; new_ev_binds <- {-# SCC "simplifyTop" #-}
simplifyTop (andWC stWC lie)
; 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
-- about strangely-typed TyCons!
-- Zonk the final code. This must be done last.
-- Even simplifyTop may do some unification.
-- 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_sigs = sig_ns,
tcg_ev_binds = cur_ev_binds,
......@@ -505,12 +518,12 @@ tcRnSrcDecls boot_iface exports decls
tcg_fords = fords } = tcg_env
; 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" #-}
zonkTopDecls all_ev_binds binds exports sig_ns rules vects
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_ev_binds = ev_binds',
tcg_imp_specs = imp_specs',
......@@ -518,28 +531,21 @@ tcRnSrcDecls boot_iface exports decls
tcg_vects = vects',
tcg_fords = fords' } } ;
setGlobalTypeEnv tcg_env' final_type_env
; setGlobalTypeEnv tcg_env' final_type_env
} }
tc_rn_src_decls :: ModDetails
-> [LHsDecl RdrName]
tc_rn_src_decls :: [LHsDecl RdrName]
-> TcM (TcGblEnv, TcLclEnv)
-- Loops around dealing with each top level inter-splice group
-- 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" #-}
do { (first_group, group_tail) <- findSplice ds
-- 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
; (tcg_env, rn_decls) <- rnTopSrcDecls extra_deps first_group
; (tcg_env, rn_decls) <- rnTopSrcDecls first_group
-- rnTopSrcDecls fails if there are any errors
#ifdef GHCI
......@@ -562,7 +568,7 @@ tc_rn_src_decls boot_details ds
-- Rename TH-generated top-level declarations
; (tcg_env, th_rn_decls) <- setGblEnv tcg_env $
rnTopSrcDecls extra_deps th_group
rnTopSrcDecls th_group
-- Dump generated top-level declarations
; let msg = "top-level declarations added with addTopDecls"
......@@ -577,21 +583,12 @@ tc_rn_src_decls boot_details ds
-- Type check all declarations
; (tcg_env, tcl_env) <- setGblEnv tcg_env $
tcTopSrcDecls boot_details rn_decls
tcTopSrcDecls rn_decls
-- If there is no splice, we're nearly done
; setEnvs (tcg_env, tcl_env) $
case group_tail of
{ Nothing -> do { tcg_env <- checkMain -- Check for `main'
#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)
}
{ Nothing -> return (tcg_env, tcl_env)
#ifndef GHCI
-- There shouldn't be a splice
......@@ -606,7 +603,7 @@ tc_rn_src_decls boot_details ds
-- Glue them on the front of the remaining decls and loop
; 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 */
......@@ -635,7 +632,7 @@ tcRnHsBootDecls hsc_src decls
hs_ruleds = rule_decls,
hs_vects = vect_decls,
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
-- See Note [Extra dependencies from .hs-boot files] in RnSource
; (gbl_env, lie) <- captureConstraints $ setGblEnv tcg_env $ do {
......@@ -653,7 +650,7 @@ tcRnHsBootDecls hsc_src decls
-- Typecheck type/class/isntance decls
; traceTc "Tc2 (boot)" empty
; (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 {
-- Typecheck value declarations
......@@ -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).
-}
checkHiBootIface :: TcGblEnv -> ModDetails -> TcM TcGblEnv
checkHiBootIface :: TcGblEnv -> SelfBootInfo -> TcM TcGblEnv
-- Compare the hi-boot file for this module (if there is one)
-- with the type environment we've just come up with
-- In the common case where there is no hi-boot file, the list
-- of boot_names is empty.
checkHiBootIface
tcg_env@(TcGblEnv { tcg_src = hs_src, tcg_binds = binds
, tcg_insts = local_insts
, tcg_type_env = local_type_env
, tcg_exports = local_exports })
boot_details
| HsBootFile <- hs_src -- Current module is already a hs-boot file!
checkHiBootIface tcg_env boot_info
| NoSelfBoot <- boot_info -- Common case
= return tcg_env
| otherwise
| HsBootFile <- tcg_src tcg_env -- Current module is already a hs-boot file!
= return tcg_env
| SelfBoot { sb_mds = boot_details } <- boot_info
, TcGblEnv { tcg_binds = binds
, tcg_insts = local_insts
, tcg_type_env = local_type_env
, tcg_exports = local_exports } <- tcg_env
= do { dfun_prs <- checkHiBootIface' local_insts local_type_env
local_exports boot_details
; let boot_dfuns = map fst dfun_prs
......@@ -726,6 +725,8 @@ checkHiBootIface
-- mentioning one of the dfuns from the boot module, then it
-- can "see" that boot dfun. See Trac #4003
| otherwise = panic "checkHiBootIface: unreachable code"
checkHiBootIface' :: [ClsInst] -> TypeEnv -> [AvailInfo]
-> ModDetails -> TcM [(Id, Id)]
-- Variant which doesn't require a full TcGblEnv; you could get the
......@@ -1087,12 +1088,12 @@ instMisMatch is_boot inst
************************************************************************
-}
rnTopSrcDecls :: Maybe FreeVars -> HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name)
rnTopSrcDecls :: HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name)
-- Fails if there are any errors
rnTopSrcDecls extra_deps group
rnTopSrcDecls group
= do { -- Rename the source decls
traceTc "rn12" empty ;
(tcg_env, rn_decls) <- checkNoErrs $ rnSrcDecls extra_deps group ;
(tcg_env, rn_decls) <- checkNoErrs $ rnSrcDecls group ;
traceTc "rn13" empty ;
-- save the renamed syntax, if we want it
......@@ -1108,9 +1109,8 @@ rnTopSrcDecls extra_deps group
return (tcg_env', rn_decls)
}
tcTopSrcDecls :: ModDetails -> HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
tcTopSrcDecls boot_details
(HsGroup { hs_tyclds = tycl_decls,
tcTopSrcDecls :: HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls,
hs_instds = inst_decls,
hs_derivds = deriv_decls,
hs_fords = foreign_decls,
......@@ -1127,7 +1127,7 @@ tcTopSrcDecls boot_details
-- and import the supporting declarations
traceTc "Tc3" empty ;
(tcg_env, inst_infos, deriv_binds)
<- tcTyClsInstDecls boot_details tycl_decls inst_decls deriv_decls ;
<- tcTyClsInstDecls tycl_decls inst_decls deriv_decls ;
setGblEnv tcg_env $ do {
......@@ -1213,8 +1213,7 @@ tcTopSrcDecls boot_details
| otherwise = greUsedRdrName gre : rdrs
---------------------------
tcTyClsInstDecls :: ModDetails
-> [TyClGroup Name]
tcTyClsInstDecls :: [TyClGroup Name]
-> [LInstDecl Name]
-> [LDerivDecl Name]
-> TcM (TcGblEnv, -- The full inst env
......@@ -1222,11 +1221,11 @@ tcTyClsInstDecls :: ModDetails
-- contains all dfuns for this module
HsValBinds Name) -- Supporting bindings for derived instances
tcTyClsInstDecls boot_details tycl_decls inst_decls deriv_decls
tcTyClsInstDecls tycl_decls inst_decls deriv_decls
= tcExtendKindEnv2 [ (con, APromotionErr FamDataConPE)
| lid <- inst_decls, con <- get_cons lid ] $
-- Note [AFamDataCon: not promoting data family constructors]
do { tcg_env <- tcTyAndClassDecls boot_details tycl_decls ;
do { tcg_env <- tcTyAndClassDecls tycl_decls ;
; setGblEnv tcg_env $
tcInstDecls1 (tyClGroupConcat tycl_decls) inst_decls deriv_decls }
where
......@@ -1268,16 +1267,16 @@ type checking 'S' we'll produce a decent error message.
************************************************************************
-}
checkMain :: TcM TcGblEnv
checkMain :: Bool -- False => no 'module M(..) where' header at all
-> TcM TcGblEnv
-- If we are in module Main, check that 'main' is defined.
checkMain
= do { tcg_env <- getGblEnv ;
dflags <- getDynFlags ;
check_main dflags tcg_env
}
checkMain explicit_mod_hdr
= do { dflags <- getDynFlags
; tcg_env <- getGblEnv
; check_main dflags tcg_env explicit_mod_hdr }
check_main :: DynFlags -> TcGblEnv -> TcM TcGblEnv
check_main dflags tcg_env
check_main :: DynFlags -> TcGblEnv -> Bool -> TcM TcGblEnv
check_main dflags tcg_env explicit_mod_hdr
| mod /= main_mod
= traceTc "checkMain not" (ppr main_mod <+> ppr mod) >>
return tcg_env
......@@ -1327,9 +1326,8 @@ check_main dflags tcg_env
main_mod = mainModIs dflags
main_fn = getMainFun dflags
interactive = ghcLink dflags == LinkInMemory
implicit_mod = isNothing (tcg_mod_name tcg_env)
complain_no_main = checkTc (interactive && implicit_mod) noMainMsg
complain_no_main = checkTc (interactive && not explicit_mod_hdr) noMainMsg
-- In interactive mode, without an explicit module header, don't
-- worry about the absence of 'main'.
-- In other modes, fail altogether, so that we don't go on
......@@ -1907,8 +1905,8 @@ tcRnDeclsi :: HscEnv
tcRnDeclsi hsc_env local_decls =
runTcInteractive hsc_env $ do
((tcg_env, tclcl_env), lie) <-
captureConstraints $ tc_rn_src_decls emptyModDetails local_decls
((tcg_env, tclcl_env), lie) <- captureConstraints $
tc_rn_src_decls local_decls
setEnvs (tcg_env, tclcl_env) $ do
-- wanted constraints from static forms
......
......@@ -120,7 +120,6 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
tcg_mod = mod,
tcg_src = hsc_src,
tcg_sig_of = getSigOf dflags (moduleName mod),
tcg_mod_name = Nothing,
tcg_impl_rdr_env = Nothing,
tcg_rdr_env = emptyGlobalRdrEnv,
tcg_fix_env = emptyNameEnv,
......@@ -162,6 +161,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
tcg_doc_hdr = Nothing,
tcg_hpc = False,
tcg_main = Nothing,
tcg_self_boot = NoSelfBoot,
tcg_safeInfer = infer_var,
tcg_dependent_files = dependent_files_var,
tcg_tc_plugins = [],
......@@ -611,6 +611,9 @@ getInteractivePrintName = do { hsc <- getTopEnv; return (ic_int_print $ hsc_IC h
tcIsHsBootOrSig :: TcRn Bool
tcIsHsBootOrSig = do { env <- getGblEnv; return (isHsBootOrSig (tcg_src env)) }
tcSelfBootInfo :: TcRn SelfBootInfo
tcSelfBootInfo = do { env <- getGblEnv; return (tcg_self_boot env) }
getGlobalRdrEnv :: TcRn GlobalRdrEnv
getGlobalRdrEnv = do { env <- getGblEnv; return (tcg_rdr_env env) }
......
......@@ -36,6 +36,7 @@ module TcRnTypes(
-- Typechecker types
TcTypeEnv, TcIdBinderStack, TcIdBinder(..),
TcTyThing(..), PromotionErr(..),
SelfBootInfo(..),
pprTcTyThingCategory, pprPECategory,
-- Desugaring types
......@@ -337,8 +338,6 @@ data TcGblEnv
-- ^ What kind of module (regular Haskell, hs-boot, hsig)
tcg_sig_of :: Maybe Module,
-- ^ Are we being compiled as a signature of an implementation?
tcg_mod_name :: Maybe (Located ModuleName),
-- ^ @Nothing@: \"module X where\" is omitted
tcg_impl_rdr_env :: Maybe GlobalRdrEnv,
-- ^ Environment used only during -sig-of for resolving top level
-- bindings. See Note [Signature parameters in TcGblEnv and DynFlags]
......@@ -477,6 +476,9 @@ data TcGblEnv
tcg_hpc :: AnyHpcUsage, -- ^ @True@ if any part of the
-- prog uses hpc instrumentation.
tcg_self_boot :: SelfBootInfo, -- ^ Whether this module has a
-- corresponding hi-boot file
tcg_main :: Maybe Name, -- ^ The Name of the main
-- function, if this module is
-- the main module.
......@@ -560,6 +562,15 @@ data RecFieldEnv
-- module. For imported modules, we get the same info from the
-- TypeEnv
data SelfBootInfo
= NoSelfBoot -- No corresponding hi-boot file
| SelfBoot
{ sb_mds :: ModDetails -- There was a hi-boot file,
, sb_tcs :: NameSet -- defining these TyCons,
, sb_ids :: NameSet } -- and these Ids
-- We need this info to compute a safe approximation to
-- recursive loops, to avoid infinite inlinings
{-
Note [Tracking unused binding and imports]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......