Commit 7379e82a authored by Simon Marlow's avatar Simon Marlow

GHC API: add checkAndLoadModule

Does what the name suggests: it performs the function of both
checkModule and load on that module, avoiding the need to process each
module twice when checking a batch of modules.  This will make Haddock
and ghctags much faster.

Along with this is the beginnings of a refactoring of the HscMain
interface.  HscMain now exports functions for separately running the
parser, typechecher, and generating ModIface and ModDetails.
Eventually the plan is to complete this interface and use it to
replace the existing one.
parent c579872a
......@@ -72,7 +72,6 @@ deSugar hsc_env
tcg_type_env = type_env,
tcg_imports = imports,
tcg_exports = exports,
tcg_dus = dus,
tcg_inst_uses = dfun_uses_var,
tcg_th_used = th_var,
tcg_keep = keep_var,
......@@ -134,46 +133,16 @@ deSugar hsc_env
; doIfSet (dopt Opt_D_dump_ds dflags)
(printDump (ppr_ds_rules ds_rules))
; dfun_uses <- readIORef dfun_uses_var -- What dfuns are used
; th_used <- readIORef th_var -- Whether TH is used
; let used_names = allUses dus `unionNameSets` dfun_uses
pkgs | th_used = insertList thPackageId (imp_dep_pkgs imports)
| otherwise = imp_dep_pkgs imports
dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
-- M.hi-boot can be in the imp_dep_mods, but we must remove
-- it before recording the modules on which this one depends!
-- (We want to retain M.hi-boot in imp_dep_mods so that
-- loadHiBootInterface can see if M's direct imports depend
-- on M.hi-boot, and hence that we should do the hi-boot consistency
-- check.)
dir_imp_mods = imp_mods imports
; usages <- mkUsageInfo hsc_env dir_imp_mods dep_mods used_names
; let
-- Modules don't compare lexicographically usually,
-- but we want them to do so here.
le_mod :: Module -> Module -> Bool
le_mod m1 m2 = moduleNameFS (moduleName m1)
<= moduleNameFS (moduleName m2)
le_dep_mod :: (ModuleName, IsBootInterface) -> (ModuleName, IsBootInterface) -> Bool
le_dep_mod (m1,_) (m2,_) = moduleNameFS m1 <= moduleNameFS m2
deps = Deps { dep_mods = sortLe le_dep_mod dep_mods,
dep_pkgs = sortLe (<=) pkgs,
dep_orphs = sortLe le_mod (imp_orphs imports),
dep_finsts = sortLe le_mod (imp_finsts imports) }
-- sort to get into canonical order
mod_guts = ModGuts {
; used_names <- mkUsedNames tcg_env
; deps <- mkDependencies tcg_env
; let mod_guts = ModGuts {
mg_module = mod,
mg_boot = isHsBoot hsc_src,
mg_exports = exports,
mg_deps = deps,
mg_usages = usages,
mg_dir_imps = [m | (m, _) <- moduleEnvElts dir_imp_mods],
mg_used_names = used_names,
mg_dir_imps = imp_mods imports,
mg_rdr_env = rdr_env,
mg_fix_env = fix_env,
mg_deprecs = deprecs,
......
......@@ -12,11 +12,13 @@
-- for details
module MkIface (
mkUsageInfo, -- Construct the usage info for a module
mkUsedNames,
mkDependencies,
mkIface, -- Build a ModIface from a ModGuts,
-- including computing version information
mkIfaceTc,
writeIfaceFile, -- Write the interface file
checkOldIface, -- See if recompilation is required, by
......@@ -222,9 +224,11 @@ import Util hiding ( eqListBy )
import FiniteMap
import FastString
import Maybes
import ListSetOps
import Control.Monad
import Data.List
import Data.IORef
\end{code}
......@@ -238,34 +242,120 @@ import Data.List
\begin{code}
mkIface :: HscEnv
-> Maybe ModIface -- The old interface, if we have it
-> ModGuts -- Usages, deprecations, etc
-> ModDetails -- The trimmed, tidied interface
-> ModGuts -- Usages, deprecations, etc
-> IO (ModIface, -- The new one, complete with decls and versions
Bool) -- True <=> there was an old Iface, and the new one
-- is identical, so no need to write it
mkIface hsc_env maybe_old_iface
(ModGuts{ mg_module = this_mod,
mkIface hsc_env maybe_old_iface mod_details
ModGuts{ mg_module = this_mod,
mg_boot = is_boot,
mg_usages = usages,
mg_used_names = used_names,
mg_deps = deps,
mg_dir_imps = dir_imp_mods,
mg_rdr_env = rdr_env,
mg_fix_env = fix_env,
mg_deprecs = src_deprecs,
mg_hpc_info = hpc_info })
(ModDetails{ md_insts = insts,
mg_deprecs = deprecs,
mg_hpc_info = hpc_info }
= mkIface_ hsc_env maybe_old_iface
this_mod is_boot used_names deps rdr_env
fix_env deprecs hpc_info dir_imp_mods mod_details
-- | make an interface from the results of typechecking only. Useful
-- for non-optimising compilation, or where we aren't generating any
-- object code at all ('HscNothing').
mkIfaceTc :: HscEnv
-> Maybe ModIface -- The old interface, if we have it
-> ModDetails -- gotten from mkBootModDetails, probably
-> TcGblEnv -- Usages, deprecations, etc
-> IO (ModIface,
Bool)
mkIfaceTc hsc_env maybe_old_iface mod_details
tc_result@TcGblEnv{ tcg_mod = this_mod,
tcg_src = hsc_src,
tcg_imports = imports,
tcg_rdr_env = rdr_env,
tcg_fix_env = fix_env,
tcg_deprecs = deprecs,
tcg_hpc = other_hpc_info
}
= do
used_names <- mkUsedNames tc_result
deps <- mkDependencies tc_result
let hpc_info = emptyHpcInfo other_hpc_info
mkIface_ hsc_env maybe_old_iface
this_mod (isHsBoot hsc_src) used_names deps rdr_env
fix_env deprecs hpc_info (imp_mods imports) mod_details
mkUsedNames :: TcGblEnv -> IO NameSet
mkUsedNames
TcGblEnv{ tcg_inst_uses = dfun_uses_var,
tcg_dus = dus
}
= do
dfun_uses <- readIORef dfun_uses_var -- What dfuns are used
return (allUses dus `unionNameSets` dfun_uses)
mkDependencies :: TcGblEnv -> IO Dependencies
mkDependencies
TcGblEnv{ tcg_mod = mod,
tcg_imports = imports,
tcg_th_used = th_var
}
= do
th_used <- readIORef th_var -- Whether TH is used
let
dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
-- M.hi-boot can be in the imp_dep_mods, but we must remove
-- it before recording the modules on which this one depends!
-- (We want to retain M.hi-boot in imp_dep_mods so that
-- loadHiBootInterface can see if M's direct imports depend
-- on M.hi-boot, and hence that we should do the hi-boot consistency
-- check.)
dir_imp_mods = imp_mods imports
-- Modules don't compare lexicographically usually,
-- but we want them to do so here.
le_mod :: Module -> Module -> Bool
le_mod m1 m2 = moduleNameFS (moduleName m1)
<= moduleNameFS (moduleName m2)
le_dep_mod :: (ModuleName, IsBootInterface)
-> (ModuleName, IsBootInterface) -> Bool
le_dep_mod (m1,_) (m2,_) = moduleNameFS m1 <= moduleNameFS m2
pkgs | th_used = insertList thPackageId (imp_dep_pkgs imports)
| otherwise = imp_dep_pkgs imports
return Deps { dep_mods = sortLe le_dep_mod dep_mods,
dep_pkgs = sortLe (<=) pkgs,
dep_orphs = sortLe le_mod (imp_orphs imports),
dep_finsts = sortLe le_mod (imp_finsts imports) }
-- sort to get into canonical order
mkIface_ hsc_env maybe_old_iface
this_mod is_boot used_names deps rdr_env fix_env src_deprecs hpc_info
dir_imp_mods
ModDetails{ md_insts = insts,
md_fam_insts = fam_insts,
md_rules = rules,
md_vect_info = vect_info,
md_types = type_env,
md_exports = exports })
md_exports = exports }
-- NB: notice that mkIface does not look at the bindings
-- only at the TypeEnv. The previous Tidy phase has
-- put exactly the info into the TypeEnv that we want
-- to expose in the interface
= do {eps <- hscEPS hsc_env
; usages <- mkUsageInfo hsc_env dir_imp_mods (dep_mods deps) used_names
; let { entities = typeEnvElts type_env ;
decls = [ tyThingToIfaceDecl entity
| entity <- entities,
......
......@@ -39,7 +39,7 @@ module GHC (
depanal,
load, LoadHowMuch(..), SuccessFlag(..), -- also does depanal
workingDirectoryChanged,
checkModule, CheckedModule(..),
checkModule, checkAndLoadModule, CheckedModule(..),
TypecheckedSource, ParsedSource, RenamedSource,
compileToCore, compileToCoreModule,
......@@ -211,6 +211,7 @@ import TcRnDriver
#endif
import TcIface
import TcRnTypes hiding (LIE)
import TcRnMonad ( initIfaceCheck )
import Packages
import NameSet
......@@ -234,7 +235,7 @@ import DriverPipeline
import DriverPhases ( HscSource(..), Phase(..), isHaskellSrcFilename, startPhase )
import HeaderInfo ( getImports, getOptions )
import Finder
import HscMain ( newHscEnv, hscFileCheck, HscChecked(..) )
import HscMain hiding (compileExpr)
import HscTypes
import DynFlags
import StaticFlags
......@@ -804,28 +805,49 @@ type TypecheckedSource = LHsBinds Id
-- If compileToCore is true, it also desugars the module and returns the
-- resulting Core bindings as a component of the CheckedModule.
checkModule :: Session -> ModuleName -> Bool -> IO (Maybe CheckedModule)
checkModule (Session ref) mod compileToCore = do
-- parse & typecheck the module
checkModule (Session ref) mod compile_to_core
= do
hsc_env <- readIORef ref
let mg = hsc_mod_graph hsc_env
case [ ms | ms <- mg, ms_mod_name ms == mod ] of
[] -> return Nothing
(ms:_) -> do
mbChecked <- hscFileCheck
hsc_env{hsc_dflags=ms_hspp_opts ms}
ms compileToCore
case mbChecked of
(ms:_) -> checkModule_ ref ms compile_to_core False
-- | parses and typechecks a module, optionally generates Core, and also
-- loads the module into the 'Session' so that modules which depend on
-- this one may subsequently be typechecked using 'checkModule' or
-- 'checkAndLoadModule'. If you need to check more than one module,
-- you probably want to use 'checkAndLoadModule'. Constructing the
-- interface takes a little work, so it might be slightly slower than
-- 'checkModule'.
checkAndLoadModule :: Session -> ModSummary -> Bool -> IO (Maybe CheckedModule)
checkAndLoadModule (Session ref) ms compile_to_core
= checkModule_ ref ms compile_to_core True
checkModule_ :: IORef HscEnv -> ModSummary -> Bool -> Bool
-> IO (Maybe CheckedModule)
checkModule_ ref ms compile_to_core load
= do
let mod = ms_mod_name ms
hsc_env0 <- readIORef ref
let hsc_env = hsc_env0{hsc_dflags=ms_hspp_opts ms}
mb_parsed <- parseFile hsc_env ms
case mb_parsed of
Nothing -> return Nothing
Just (HscChecked parsed renamed Nothing _) ->
return (Just (CheckedModule {
parsedSource = parsed,
renamedSource = renamed,
typecheckedSource = Nothing,
checkedModuleInfo = Nothing,
coreModule = Nothing }))
Just (HscChecked parsed renamed
(Just (tc_binds, rdr_env, details))
maybeCoreBinds) -> do
Just rdr_module -> do
mb_typechecked <- typecheckRenameModule hsc_env ms rdr_module
case mb_typechecked of
Nothing -> return (Just CheckedModule {
parsedSource = rdr_module,
renamedSource = Nothing,
typecheckedSource = Nothing,
checkedModuleInfo = Nothing,
coreModule = Nothing })
Just (tcg, rn_info) -> do
details <- makeSimpleDetails hsc_env tcg
let tc_binds = tcg_binds tcg
let rdr_env = tcg_rdr_env tcg
let minf = ModuleInfo {
minf_type_env = md_types details,
minf_exports = availsToNameSet $
......@@ -836,12 +858,35 @@ checkModule (Session ref) mod compileToCore = do
,minf_modBreaks = emptyModBreaks
#endif
}
mb_guts <- if compile_to_core
then deSugarModule hsc_env ms tcg
else return Nothing
let mb_core = fmap (\ mg ->
CoreModule { cm_module = mg_module mg,
cm_types = mg_types mg,
cm_binds = mg_binds mg })
mb_guts
-- If we are loading this module so that we can typecheck
-- dependent modules, generate an interface and stuff it
-- all in the HomePackageTable.
when load $ do
(iface,_) <- makeSimpleIface hsc_env Nothing tcg details
let mod_info = HomeModInfo {
hm_iface = iface,
hm_details = details,
hm_linkable = Nothing }
let hpt_new = addToUFM (hsc_HPT hsc_env) mod mod_info
writeIORef ref hsc_env0{ hsc_HPT = hpt_new }
return (Just (CheckedModule {
parsedSource = parsed,
renamedSource = renamed,
parsedSource = rdr_module,
renamedSource = rn_info,
typecheckedSource = Just tc_binds,
checkedModuleInfo = Just minf,
coreModule = maybeCoreBinds}))
coreModule = mb_core }))
-- | This is the way to get access to the Core bindings corresponding
-- to a module. 'compileToCore' invokes 'checkModule' to parse, typecheck, and
......
......@@ -7,7 +7,6 @@
\begin{code}
module HscMain
( newHscEnv, hscCmmFile
, hscFileCheck
, hscParseIdentifier
#ifdef GHCI
, hscStmt, hscTcExpr, hscKcType
......@@ -19,13 +18,19 @@ module HscMain
, hscCompileInteractive -- :: Compiler (InteractiveStatus, ModIface, ModDetails)
, HscStatus (..)
, InteractiveStatus (..)
, HscChecked (..)
-- The new interface
, parseFile
, typecheckModule
, typecheckRenameModule
, deSugarModule
, makeSimpleIface
, makeSimpleDetails
) where
#include "HsVersions.h"
#ifdef GHCI
import HsSyn ( StmtLR(..), LStmt, LHsType )
import CodeOutput ( outputForeignStubs )
import ByteCodeGen ( byteCodeGen, coreExprToBCOs )
import Linker ( HValue, linkExpr )
......@@ -47,9 +52,8 @@ import VarEnv ( emptyTidyEnv )
import Var ( Id )
import Module ( emptyModuleEnv, ModLocation(..), Module )
import RdrName ( GlobalRdrEnv, RdrName, emptyGlobalRdrEnv )
import HsSyn ( HsModule, LHsBinds, HsGroup, LIE, LImportDecl, HsDoc,
HaddockModInfo )
import RdrName
import HsSyn
import CoreSyn
import SrcLoc ( Located(..) )
import StringBuffer
......@@ -62,10 +66,10 @@ import TcRnMonad ( initIfaceCheck, TcGblEnv(..) )
import IfaceEnv ( initNameCache )
import LoadIface ( ifaceStats, initExternalPackageState )
import PrelInfo ( wiredInThings, basicKnownKeyNames )
import MkIface ( checkOldIface, mkIface, writeIfaceFile )
import MkIface
import Desugar ( deSugar )
import SimplCore ( core2core )
import TidyPgm ( tidyProgram, mkBootModDetails )
import TidyPgm
import CorePrep ( corePrepPgm )
import CoreToStg ( coreToStg )
import StgSyn
......@@ -144,6 +148,85 @@ knownKeyNames = map getName wiredInThings
\end{code}
\begin{code}
-- | parse a file, returning the abstract syntax
parseFile :: HscEnv -> ModSummary -> IO (Maybe (Located (HsModule RdrName)))
parseFile hsc_env mod_summary
= do
maybe_parsed <- myParseModule dflags hspp_file hspp_buf
case maybe_parsed of
Left err
-> do printBagOfErrors dflags (unitBag err)
return Nothing
Right rdr_module
-> return (Just rdr_module)
where
dflags = hsc_dflags hsc_env
hspp_file = ms_hspp_file mod_summary
hspp_buf = ms_hspp_buf mod_summary
-- | Rename and typecheck a module
typecheckModule :: HscEnv -> ModSummary -> Located (HsModule RdrName)
-> IO (Maybe TcGblEnv)
typecheckModule hsc_env mod_summary rdr_module
= do
(tc_msgs, maybe_tc_result)
<- {-# SCC "Typecheck-Rename" #-}
tcRnModule hsc_env (ms_hsc_src mod_summary) False rdr_module
printErrorsAndWarnings dflags tc_msgs
return maybe_tc_result
where
dflags = hsc_dflags hsc_env
type RenamedStuff =
(Maybe (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
Maybe (HsDoc Name), HaddockModInfo Name))
-- | Rename and typecheck a module, additinoally returning the renamed syntax
typecheckRenameModule :: HscEnv -> ModSummary -> Located (HsModule RdrName)
-> IO (Maybe (TcGblEnv, RenamedStuff))
typecheckRenameModule hsc_env mod_summary rdr_module
= do
(tc_msgs, maybe_tc_result)
<- {-# SCC "Typecheck-Rename" #-}
tcRnModule hsc_env (ms_hsc_src mod_summary) True rdr_module
printErrorsAndWarnings dflags tc_msgs
case maybe_tc_result of
Nothing -> return Nothing
Just tc_result -> do
let rn_info = do decl <- tcg_rn_decls tc_result
imports <- tcg_rn_imports tc_result
let exports = tcg_rn_exports tc_result
let doc = tcg_doc tc_result
let hmi = tcg_hmi tc_result
return (decl,imports,exports,doc,hmi)
return (Just (tc_result, rn_info))
where
dflags = hsc_dflags hsc_env
-- | Convert a typechecked module to Core
deSugarModule :: HscEnv -> ModSummary -> TcGblEnv -> IO (Maybe ModGuts)
deSugarModule hsc_env mod_summary tc_result
= deSugar hsc_env (ms_location mod_summary) tc_result
-- | Make a 'ModIface' from the results of typechecking. Used when
-- not optimising, and the interface doesn't need to contain any
-- unfoldings or other cross-module optimisation info.
-- ToDo: the old interface is only needed to get the version numbers,
-- we should use fingerprint versions instead.
makeSimpleIface :: HscEnv -> Maybe ModIface -> TcGblEnv -> ModDetails
-> IO (ModIface,Bool)
makeSimpleIface hsc_env maybe_old_iface tc_result details = do
mkIfaceTc hsc_env maybe_old_iface details tc_result
-- | Make a 'ModDetails' from the results of typechecking. Used when
-- typechecking only, as opposed to full compilation.
makeSimpleDetails :: HscEnv -> TcGblEnv -> IO ModDetails
makeSimpleDetails hsc_env tc_result = mkBootModDetailsTc hsc_env tc_result
-- deSugarModule :: HscEnv -> TcGblEnv -> IO Core
\end{code}
%************************************************************************
%* *
The main compiler pipeline
......@@ -183,18 +266,6 @@ error. This is the only thing that isn't caught by the type-system.
\begin{code}
data HscChecked
= HscChecked
-- parsed
(Located (HsModule RdrName))
-- renamed
(Maybe (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
Maybe (HsDoc Name), HaddockModInfo Name))
-- typechecked
(Maybe (LHsBinds Id, GlobalRdrEnv, ModDetails))
-- desugared
(Maybe CoreModule)
-- Status of a compilation to hard-code or nothing.
data HscStatus
= HscNoRecomp
......@@ -477,10 +548,10 @@ hscSimpleIface ds_result
_mod_summary <- gets compModSummary
maybe_old_iface <- gets compOldIface
liftIO $ do
details <- mkBootModDetails hsc_env ds_result
details <- mkBootModDetailsDs hsc_env ds_result
(new_iface, no_change)
<- {-# SCC "MkFinalIface" #-}
mkIface hsc_env maybe_old_iface ds_result details
mkIface hsc_env maybe_old_iface details ds_result
-- And the answer is ...
dumpIfaceStats hsc_env
return (new_iface, no_change, details, ds_result)
......@@ -505,7 +576,7 @@ hscNormalIface simpl_result
-- until after code output
(new_iface, no_change)
<- {-# SCC "MkFinalIface" #-}
mkIface hsc_env maybe_old_iface simpl_result details
mkIface hsc_env maybe_old_iface details simpl_result
-- Emit external core
emitExternalCore (hsc_dflags hsc_env) (availsToNameSet (mg_exports simpl_result)) cg_guts -- Move this? --Lemmih 03/07/2006
dumpIfaceStats hsc_env
......@@ -631,72 +702,6 @@ hscInteractive _ = panic "GHC not compiled with interpreter"
------------------------------
hscFileCheck :: HscEnv -> ModSummary -> Bool -> IO (Maybe HscChecked)
hscFileCheck hsc_env mod_summary compileToCore = do {
-------------------
-- PARSE
-------------------
; let dflags = hsc_dflags hsc_env
hspp_file = ms_hspp_file mod_summary
hspp_buf = ms_hspp_buf mod_summary
; maybe_parsed <- myParseModule dflags hspp_file hspp_buf
; case maybe_parsed of {
Left err -> do { printBagOfErrors dflags (unitBag err)
; return Nothing } ;
Right rdr_module -> do {
-------------------
-- RENAME and TYPECHECK
-------------------
(tc_msgs, maybe_tc_result)
<- {-# SCC "Typecheck-Rename" #-}
tcRnModule hsc_env (ms_hsc_src mod_summary)
True{-save renamed syntax-}
rdr_module
; printErrorsAndWarnings dflags tc_msgs
; case maybe_tc_result of {
Nothing -> return (Just (HscChecked rdr_module Nothing Nothing Nothing));
Just tc_result -> do
let type_env = tcg_type_env tc_result
md = ModDetails {
md_types = type_env,
md_exports = tcg_exports tc_result,
md_insts = tcg_insts tc_result,
md_fam_insts = tcg_fam_insts tc_result,
md_rules = [panic "no rules"],
-- Rules are CoreRules, not the
-- RuleDecls we get out of the typechecker
md_vect_info = noVectInfo
-- VectInfo is added by the Core
-- vectorisation pass
}
rnInfo = do decl <- tcg_rn_decls tc_result
imports <- tcg_rn_imports tc_result
let exports = tcg_rn_exports tc_result
let doc = tcg_doc tc_result
hmi = tcg_hmi tc_result
return (decl,imports,exports,doc,hmi)
maybeModGuts <-
if compileToCore then
deSugar hsc_env (ms_location mod_summary) tc_result
else
return Nothing
return (Just (HscChecked rdr_module
rnInfo
(Just (tcg_binds tc_result,
tcg_rdr_env tc_result,
md))
(fmap (\ mg ->
(CoreModule { cm_module = mg_module mg,
cm_types = mg_types mg,
cm_binds = mg_binds mg}))
maybeModGuts)))
}}}}
hscCmmFile :: DynFlags -> FilePath -> IO Bool
hscCmmFile dflags filename = do
maybe_cmm <- parseCmmFile dflags filename
......
......@@ -14,6 +14,7 @@ module HscTypes (
ModDetails(..), emptyModDetails,
ModGuts(..), CoreModule(..), CgGuts(..), ModImports(..), ForeignStubs(..),
ImportedMods,
ModSummary(..), ms_mod_name, showModMsg, isBootSummary,
msHsFilePath, msHiFilePath, msObjFilePath,
......@@ -509,6 +510,8 @@ emptyModDetails = ModDetails { md_types = emptyTypeEnv,
-- being compiled right now. Once it is compiled, a ModIface and
-- ModDetails are extracted and the ModGuts is dicarded.
type ImportedMods = ModuleEnv (Module, [(ModuleName, Bool, SrcSpan)])
data ModGuts
= ModGuts {
mg_module :: !Module,
......@@ -516,9 +519,9 @@ data ModGuts
mg_exports :: ![AvailInfo], -- What it exports
mg_deps :: !Dependencies, -- What is below it, directly or
-- otherwise
mg_dir_imps :: ![Module], -- Directly-imported modules; used to
mg_dir_imps :: !ImportedMods, -- Directly-imported modules; used to
-- generate initialisation code
mg_usages :: ![Usage], -- Version info for what it needed
mg_used_names:: !NameSet, -- What it needed (used in mkIface)
mg_rdr_env :: !GlobalRdrEnv, -- Top-level lexical environment
......
......@@ -4,10 +4,12 @@
\section{Tidying up Core}
\begin{code}
module TidyPgm( mkBootModDetails, tidyProgram ) where
module TidyPgm( mkBootModDetailsDs, mkBootModDetailsTc, tidyProgram ) where
#include "HsVersions.h"
import TcRnTypes
import FamInstEnv
import DynFlags
import CoreSyn
import CoreUnfold
......@@ -105,18 +107,33 @@ Plan A: mkBootModDetails: omit pragmas, make interfaces small
distinct OccNames in case of object-file splitting
\begin{code}
mkBootModDetails :: HscEnv -> ModGuts -> IO ModDetails
-- This is Plan A: make a small type env when typechecking only,
-- or when compiling a hs-boot file, or simply when not using -O
--
-- We don't look at the bindings at all -- there aren't any
-- for hs-boot files
mkBootModDetails hsc_env (ModGuts { mg_exports = exports
, mg_types = type_env
, mg_insts = insts
, mg_fam_insts = fam_insts
})
mkBootModDetailsTc :: HscEnv -> TcGblEnv -> IO ModDetails
mkBootModDetailsTc hsc_env
TcGblEnv{ tcg_exports = exports,
tcg_type_env = type_env,
tcg_insts = insts,
tcg_fam_insts = fam_insts
}
= mkBootModDetails hsc_env exports type_env insts fam_insts
mkBootModDetailsDs :: HscEnv -> ModGuts -> IO ModDetails
mkBootModDetailsDs hsc_env
ModGuts{ mg_exports = exports,