clearWarnings, getWarnings, hasWarnings,
printExceptionAndWarnings, printWarnings,
handleSourceError, defaultCallbacks, GhcApiCallbacks(..),
+ needsTemplateHaskell,
-- * Flags and settings
DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt,
-- * Loading\/compiling the program
depanal,
- load, loadWithLogger, LoadHowMuch(..), SuccessFlag(..), -- also does depanal
+ load, loadWithLogger, LoadHowMuch(..),
+ SuccessFlag(..), succeeded, failed,
defaultWarnErrLogger, WarnErrLogger,
workingDirectoryChanged,
parseModule, typecheckModule, desugarModule, loadModule,
- ParsedModule, TypecheckedModule, DesugaredModule, -- all abstract
+ ParsedModule(..), TypecheckedModule(..), DesugaredModule(..),
TypecheckedSource, ParsedSource, RenamedSource, -- ditto
TypecheckedMod, ParsedMod,
moduleInfo, renamedSource, typecheckedSource,
-- * Interactive evaluation
getBindings, getPrintUnqual,
findModule,
+ lookupModule,
#ifdef GHCI
setContext, getContext,
getNamesInScope,
import TysPrim ( alphaTyVars )
import TyCon
import Class
-import FunDeps
+-- import FunDeps
import DataCon
import Name hiding ( varName )
-import OccName ( parenSymOcc )
+-- import OccName ( parenSymOcc )
import InstEnv ( Instance, instanceDFunId, pprInstance, pprInstanceHdr,
emptyInstEnv )
import FamInstEnv ( emptyFamInstEnv )
--import CoreSyn
import TidyPgm
import DriverPipeline
-import DriverPhases ( HscSource(..), Phase(..), isHaskellSrcFilename, startPhase )
+import DriverPhases ( Phase(..), isHaskellSrcFilename, startPhase )
import HeaderInfo
import Finder
import HscMain
import Module
import LazyUniqFM
import qualified UniqFM as UFM
-import UniqSet
-import Unique
import FiniteMap
import Panic
import Digraph
DynFlags -> m a -> m a
defaultCleanupHandler dflags inner =
-- make sure we clean up after ourselves
- inner `gonException`
+ inner `gfinally`
(liftIO $ do
cleanTempFiles dflags
cleanTempDirs dflags
-- | Perform a dependency analysis starting from the current targets
-- and update the session with the new module graph.
+--
+-- Dependency analysis entails parsing the @import@ directives and may
+-- therefore require running certain preprocessors.
+--
+-- Note that each 'ModSummary' in the module graph caches its 'DynFlags'.
+-- These 'DynFlags' are determined by the /current/ session 'DynFlags' and the
+-- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module. Thus if you want to
+-- changes to the 'DynFlags' to take effect you need to call this function
+-- again.
+--
depanal :: GhcMonad m =>
[ModuleName] -- ^ excluded modules
-> Bool -- ^ allow duplicate roots
modifySession $ \_ -> hsc_env { hsc_mod_graph = mod_graph }
return mod_graph
+-- | Describes which modules of the module graph need to be loaded.
data LoadHowMuch
= LoadAllTargets
+ -- ^ Load all targets and its dependencies.
| LoadUpTo ModuleName
+ -- ^ Load only the given module and its dependencies.
| LoadDependenciesOf ModuleName
+ -- ^ Load only the dependencies of the given module, but not the module
+ -- itself.
--- | Try to load the program. Calls 'loadWithLogger' with the default
--- compiler that just immediately logs all warnings and errors.
+-- | Try to load the program. See 'LoadHowMuch' for the different modes.
--
--- This function may throw a 'SourceError' if errors are encountered before
--- the actual compilation starts (e.g., during dependency analysis).
+-- This function implements the core of GHC's @--make@ mode. It preprocesses,
+-- compiles and loads the specified modules, avoiding re-compilation wherever
+-- possible. Depending on the target (see 'DynFlags.hscTarget') compilating
+-- and loading may result in files being created on disk.
+--
+-- Calls the 'reportModuleCompilationResult' callback after each compiling
+-- each module, whether successful or not.
+--
+-- Throw a 'SourceError' if errors are encountered before the actual
+-- compilation starts (e.g., during dependency analysis). All other errors
+-- are reported using the callback.
--
load :: GhcMonad m => LoadHowMuch -> m SuccessFlag
load how_much = do
(flattenSCCs mg2_with_srcimps)
stable_mods
- liftIO $ evaluate pruned_hpt
+ _ <- liftIO $ evaluate pruned_hpt
-- before we unload anything, make sure we don't leave an old
-- interactive context around pointing to dead bindings. Also,
let
main_mod = mainModIs dflags
a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
- do_linking = a_root_is_Main || no_hs_main
+ do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib
when (ghcLink dflags == LinkBinary
&& isJust ofile && not do_linking) $
-- | Load a module. Input doesn't need to be desugared.
--
--- XXX: Describe usage.
+-- A module must be loaded before dependent modules can be typechecked. This
+-- always includes generating a 'ModIface' and, depending on the
+-- 'DynFlags.hscTarget', may also include code generation.
+--
+-- This function will always cause recompilation and will always overwrite
+-- previous compilation results (potentially files on disk).
+--
loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod
loadModule tcm = do
let ms = modSummary tcm
(iface, changed, _details, cgguts)
<- hscNormalIface guts Nothing
hscWriteIface iface changed modSummary
- hscGenHardCode cgguts modSummary
+ _ <- hscGenHardCode cgguts modSummary
return ()
-- Makes a "vanilla" ModGuts.
-- First, set the target to the desired filename
target <- guessTarget fn Nothing
addTarget target
- load LoadAllTargets
+ _ <- load LoadAllTargets
-- Then find dependencies
modGraph <- depanal [] True
case find ((== fn) . msHsFilePath) modGraph of
-> IO () -- ^ How to clean up unwanted tmp files
-> [SCC ModSummary] -- ^ Mods to do (the worklist)
-> m (SuccessFlag,
- HscEnv, -- With an updated HPT
- [ModSummary]) -- Mods which succeeded
+ HscEnv,
+ [ModSummary])
+ -- ^ Returns:
+ --
+ -- 1. A flag whether the complete upsweep was successful.
+ -- 2. The 'HscEnv' with an updated HPT
+ -- 3. A list of modules which succeeded loading.
upsweep hsc_env old_hpt stable_mods cleanup sccs = do
(res, hsc_env, done) <- upsweep' hsc_env old_hpt [] sccs 1 (length sccs)
-- ^ Drop hi-boot nodes? (see below)
-> [ModSummary]
-> Maybe ModuleName
+ -- ^ Root module name. If @Nothing@, use the full graph.
-> [SCC ModSummary]
-- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
-- The resulting list of strongly-connected-components is in topologically
getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
getModuleGraph = liftM hsc_mod_graph getSession
+-- | Determines whether a set of modules requires Template Haskell.
+--
+-- Note that if the session's 'DynFlags' enabled Template Haskell when
+-- 'depanal' was called, then each module in the returned module graph will
+-- have Template Haskell enabled whether it is actually needed or not.
+needsTemplateHaskell :: ModuleGraph -> Bool
+needsTemplateHaskell ms =
+ any (dopt Opt_TemplateHaskell . ms_hspp_opts) ms
+
-- | Return @True@ <==> module is loaded.
isLoaded :: GhcMonad m => ModuleName -> m Bool
isLoaded m = withSession $ \hsc_env ->
-- we have to implement the shadowing behaviour of ic_tmp_ids here
-- (see InteractiveContext) and the quickest way is to use an OccEnv.
let
- tmp_ids = ic_tmp_ids (hsc_IC hsc_env)
- filtered = foldr f (const []) tmp_ids emptyUniqSet
- f id rest set
- | uniq `elementOfUniqSet` set = rest set
- | otherwise = AnId id : rest (addOneToUniqSet set uniq)
- where uniq = getUnique (nameOccName (idName id))
+ occ_env = mkOccEnv [ (nameOccName (idName id), AnId id)
+ | id <- ic_tmp_ids (hsc_IC hsc_env) ]
in
- return filtered
+ return (occEnvElts occ_env)
getPrintUnqual :: GhcMonad m => m PrintUnqualified
getPrintUnqual = withSession $ \hsc_env ->
-- filesystem and package database to find the corresponding 'Module',
-- using the algorithm that is used for an @import@ declaration.
findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
-findModule mod_name maybe_pkg = withSession $ \hsc_env -> liftIO $ -- XXX
- let
- dflags = hsc_dflags hsc_env
- hpt = hsc_HPT hsc_env
- this_pkg = thisPackage dflags
- in
- case lookupUFM hpt mod_name of
- Just mod_info -> return (mi_module (hm_iface mod_info))
- _not_a_home_module -> do
- res <- findImportedModule hsc_env mod_name maybe_pkg
- case res of
- Found _ m | modulePackageId m /= this_pkg -> return m
- | otherwise -> ghcError (CmdLineError (showSDoc $
- text "module" <+> quotes (ppr (moduleName m)) <+>
- text "is not loaded"))
- err -> let msg = cannotFindModule dflags mod_name err in
- ghcError (CmdLineError (showSDoc msg))
+findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
+ let
+ dflags = hsc_dflags hsc_env
+ this_pkg = thisPackage dflags
+ --
+ case maybe_pkg of
+ Just pkg | fsToPackageId pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
+ res <- findImportedModule hsc_env mod_name maybe_pkg
+ case res of
+ Found _ m -> return m
+ err -> noModError dflags noSrcSpan mod_name err
+ _otherwise -> do
+ home <- lookupLoadedHomeModule mod_name
+ case home of
+ Just m -> return m
+ Nothing -> liftIO $ do
+ res <- findImportedModule hsc_env mod_name maybe_pkg
+ case res of
+ Found loc m | modulePackageId m /= this_pkg -> return m
+ | otherwise -> modNotLoadedError m loc
+ err -> noModError dflags noSrcSpan mod_name err
+
+modNotLoadedError :: Module -> ModLocation -> IO a
+modNotLoadedError m loc = ghcError $ CmdLineError $ showSDoc $
+ text "module is not loaded:" <+>
+ quotes (ppr (moduleName m)) <+>
+ parens (text (expectJust "modNotLoadedError" (ml_hs_file loc)))
+
+-- | Like 'findModule', but differs slightly when the module refers to
+-- a source file, and the file has not been loaded via 'load'. In
+-- this case, 'findModule' will throw an error (module not loaded),
+-- but 'lookupModule' will check to see whether the module can also be
+-- found in a package, and if so, that package 'Module' will be
+-- returned. If not, the usual module-not-found error will be thrown.
+--
+lookupModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
+lookupModule mod_name (Just pkg) = findModule mod_name (Just pkg)
+lookupModule mod_name Nothing = withSession $ \hsc_env -> do
+ home <- lookupLoadedHomeModule mod_name
+ case home of
+ Just m -> return m
+ Nothing -> liftIO $ do
+ res <- findExposedPackageModule hsc_env mod_name Nothing
+ case res of
+ Found _ m -> return m
+ err -> noModError (hsc_dflags hsc_env) noSrcSpan mod_name err
+
+lookupLoadedHomeModule :: GhcMonad m => ModuleName -> m (Maybe Module)
+lookupLoadedHomeModule mod_name = withSession $ \hsc_env ->
+ case lookupUFM (hsc_HPT hsc_env) mod_name of
+ Just mod_info -> return (Just (mi_module (hm_iface mod_info)))
+ _not_a_home_module -> return Nothing
#ifdef GHCI
getHistorySpan :: GhcMonad m => History -> m SrcSpan
projects / ghc-hetmet.git / blobdiff