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,
; 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,
-- 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
import FiniteMap
import FastString
import Maybes
+import ListSetOps
import Control.Monad
import Data.List
+import Data.IORef
\end{code}
\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,
depanal,
load, LoadHowMuch(..), SuccessFlag(..), -- also does depanal
workingDirectoryChanged,
- checkModule, CheckedModule(..),
+ checkModule, checkAndLoadModule, CheckedModule(..),
TypecheckedSource, ParsedSource, RenamedSource,
compileToCore, compileToCoreModule,
#endif
import TcIface
+import TcRnTypes hiding (LIE)
import TcRnMonad ( initIfaceCheck )
import Packages
import NameSet
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
-- 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 $
,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
\begin{code}
module HscMain
( newHscEnv, hscCmmFile
- , hscFileCheck
, hscParseIdentifier
#ifdef GHCI
, hscStmt, hscTcExpr, hscKcType
, 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 )
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
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
\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
\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
_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)
-- 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
------------------------------
-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
ModDetails(..), emptyModDetails,
ModGuts(..), CoreModule(..), CgGuts(..), ModImports(..), ForeignStubs(..),
+ ImportedMods,
ModSummary(..), ms_mod_name, showModMsg, isBootSummary,
msHsFilePath, msHiFilePath, msObjFilePath,
-- 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,
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
\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
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,
+ mg_types = type_env,
+ mg_insts = insts,
+ mg_fam_insts = fam_insts
+ }
+ = mkBootModDetails hsc_env exports type_env insts fam_insts
+
+mkBootModDetails :: HscEnv -> [AvailInfo] -> NameEnv TyThing
+ -> [Instance] -> [FamInstEnv.FamInst] -> IO ModDetails
+mkBootModDetails hsc_env exports type_env insts fam_insts
= do { let dflags = hsc_dflags hsc_env
; showPass dflags "Tidy [hoot] type env"
mg_binds = binds,
mg_rules = imp_rules,
mg_vect_info = vect_info,
- mg_dir_imps = dir_imps, mg_deps = deps,
+ mg_dir_imps = dir_imps,
+ mg_deps = deps,
mg_foreign = foreign_stubs,
mg_hpc_info = hpc_info,
mg_modBreaks = modBreaks })
"Tidy Core Rules"
(pprRules tidy_rules)
+ ; let dir_imp_mods = map fst (moduleEnvElts dir_imps)
+
; return (CgGuts { cg_module = mod,
cg_tycons = alg_tycons,
cg_binds = all_tidy_binds,
- cg_dir_imps = dir_imps,
+ cg_dir_imps = dir_imp_mods,
cg_foreign = foreign_stubs,
cg_dep_pkgs = dep_pkgs deps,
cg_hpc_info = hpc_info,
mod_guts = ModGuts { mg_module = this_mod,
mg_boot = False,
- mg_usages = [], -- ToDo: compute usage
- mg_dir_imps = [], -- ??
+ mg_used_names = emptyNameSet, -- ToDo: compute usage
+ mg_dir_imps = emptyModuleEnv, -- ??
mg_deps = noDependencies, -- ??
mg_exports = my_exports,
mg_types = final_type_env,
projects / ghc-hetmet.git / commitdiff