parseModule, typecheckModule, desugarModule, loadModule,
ParsedModule, TypecheckedModule, DesugaredModule, -- all abstract
TypecheckedSource, ParsedSource, RenamedSource, -- ditto
+ TypecheckedMod, ParsedMod,
moduleInfo, renamedSource, typecheckedSource,
parsedSource, coreModule,
compileToCoreModule, compileToCoreSimplified,
modInfoIsExportedName,
modInfoLookupName,
lookupGlobalName,
+ findGlobalAnns,
mkPrintUnqualifiedForModule,
+ -- * Querying the environment
+ packageDbModules,
+
-- * Printing
PrintUnqualified, alwaysQualify,
srcSpanStartLine, srcSpanEndLine,
srcSpanStartCol, srcSpanEndCol,
+ -- ** Located
+ Located(..),
+
+ -- *** Constructing Located
+ noLoc, mkGeneralLocated,
+
+ -- *** Deconstructing Located
+ getLoc, unLoc,
+
+ -- *** Combining and comparing Located values
+ eqLocated, cmpLocated, combineLocs, addCLoc,
+ leftmost_smallest, leftmost_largest, rightmost,
+ spans, isSubspanOf,
+
-- * Exceptions
GhcException(..), showGhcException,
import qualified StaticFlags
import SysTools ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
cleanTempDirs )
+import Annotations
import Module
import LazyUniqFM
+import qualified UniqFM as UFM
import UniqSet
import Unique
import FiniteMap
import Data.Maybe
import Data.List
import qualified Data.List as List
+import Data.Typeable ( Typeable )
+import Data.Word ( Word8 )
import Control.Monad
import System.Exit ( exitWith, ExitCode(..) )
import System.Time ( ClockTime, getClockTime )
exitWith (ExitFailure 1)
) $
- -- program errors: messages with locations attached. Sometimes it is
- -- convenient to just throw these as exceptions.
- handleErrMsg
- (\em -> liftIO $ do
- printBagOfErrors dflags (unitBag em)
- exitWith (ExitFailure 1)) $
-
-- error messages propagated as exceptions
handleGhcException
(\ge -> liftIO $ do
-- | Try to load the program. Calls 'loadWithLogger' with the default
-- compiler that just immediately logs all warnings and errors.
+--
+-- This function may throw a 'SourceError' if errors are encountered before
+-- the actual compilation starts (e.g., during dependency analysis).
+--
load :: GhcMonad m => LoadHowMuch -> m SuccessFlag
load how_much =
loadWithLogger defaultWarnErrLogger how_much
--
-- The first argument is a function that is called after compiling each
-- module to print wanrings and errors.
-
+--
+-- While compiling a module, all 'SourceError's are caught and passed to the
+-- logger, however, this function may still throw a 'SourceError' if
+-- dependency analysis failed (e.g., due to a parse error).
+--
loadWithLogger :: GhcMonad m => WarnErrLogger -> LoadHowMuch -> m SuccessFlag
loadWithLogger logger how_much = do
-- Dependency analysis first. Note that this fixes the module graph:
mg_binds = cm_binds coreModule,
mg_foreign = NoStubs,
mg_warns = NoWarnings,
+ mg_anns = [],
mg_hpc_info = emptyHpcInfo False,
mg_modBreaks = emptyModBreaks,
mg_vect_info = noVectInfo,
= compile hsc_env summary' mod_index nmods Nothing
in
- case target of
-
- _any
+ case () of
+ _
-- Regardless of whether we're generating object code or
-- byte code, we can always use an existing object file
-- if it is *stable* (see checkStability).
- | is_stable_obj, isJust old_hmi ->
- let Just hmi = old_hmi in
- return hmi
- -- object is stable, and we have an entry in the
- -- old HPT: nothing to do
-
- | is_stable_obj, isNothing old_hmi -> do
- linkable <- liftIO $ findObjectLinkable this_mod obj_fn
- (expectJust "upsweep1" mb_obj_date)
- compile_it (Just linkable)
- -- object is stable, but we need to load the interface
- -- off disk to make a HMI.
-
- HscInterpreted
- | is_stable_bco ->
- ASSERT(isJust old_hmi) -- must be in the old_hpt
- let Just hmi = old_hmi in
- return hmi
- -- BCO is stable: nothing to do
-
- | Just hmi <- old_hmi,
- Just l <- hm_linkable hmi, not (isObjectLinkable l),
- linkableTime l >= ms_hs_date summary ->
- compile_it (Just l)
- -- we have an old BCO that is up to date with respect
- -- to the source: do a recompilation check as normal.
-
- | otherwise ->
- compile_it Nothing
- -- no existing code at all: we must recompile.
-
- -- When generating object code, if there's an up-to-date
- -- object file on the disk, then we can use it.
- -- However, if the object file is new (compared to any
- -- linkable we had from a previous compilation), then we
- -- must discard any in-memory interface, because this
- -- means the user has compiled the source file
- -- separately and generated a new interface, that we must
- -- read from the disk.
- --
- obj | isObjectTarget obj,
- Just obj_date <- mb_obj_date, obj_date >= hs_date -> do
- case old_hmi of
- Just hmi
- | Just l <- hm_linkable hmi,
- isObjectLinkable l && linkableTime l == obj_date
- -> compile_it (Just l)
- _otherwise -> do
- linkable <- liftIO $ findObjectLinkable this_mod obj_fn obj_date
+ | is_stable_obj, Just hmi <- old_hmi -> do
+ liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
+ (text "skipping stable obj mod:" <+> ppr this_mod_name)
+ return hmi
+ -- object is stable, and we have an entry in the
+ -- old HPT: nothing to do
+
+ | is_stable_obj, isNothing old_hmi -> do
+ liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
+ (text "compiling stable on-disk mod:" <+> ppr this_mod_name)
+ linkable <- liftIO $ findObjectLinkable this_mod obj_fn
+ (expectJust "upsweep1" mb_obj_date)
+ compile_it (Just linkable)
+ -- object is stable, but we need to load the interface
+ -- off disk to make a HMI.
+
+ | not (isObjectTarget target), is_stable_bco ->
+ ASSERT(isJust old_hmi) -- must be in the old_hpt
+ let Just hmi = old_hmi in do
+ liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
+ (text "skipping stable BCO mod:" <+> ppr this_mod_name)
+ return hmi
+ -- BCO is stable: nothing to do
+
+ | not (isObjectTarget target),
+ Just hmi <- old_hmi,
+ Just l <- hm_linkable hmi,
+ not (isObjectLinkable l),
+ linkableTime l >= ms_hs_date summary -> do
+ liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
+ (text "compiling non-stable BCO mod:" <+> ppr this_mod_name)
+ compile_it (Just l)
+ -- we have an old BCO that is up to date with respect
+ -- to the source: do a recompilation check as normal.
+
+ -- When generating object code, if there's an up-to-date
+ -- object file on the disk, then we can use it.
+ -- However, if the object file is new (compared to any
+ -- linkable we had from a previous compilation), then we
+ -- must discard any in-memory interface, because this
+ -- means the user has compiled the source file
+ -- separately and generated a new interface, that we must
+ -- read from the disk.
+ --
+ | isObjectTarget target,
+ Just obj_date <- mb_obj_date,
+ obj_date >= hs_date -> do
+ case old_hmi of
+ Just hmi
+ | Just l <- hm_linkable hmi,
+ isObjectLinkable l && linkableTime l == obj_date -> do
+ liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
+ (text "compiling mod with new on-disk obj:" <+> ppr this_mod_name)
+ compile_it (Just l)
+ _otherwise -> do
+ liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
+ (text "compiling mod with new on-disk obj2:" <+> ppr this_mod_name)
+ linkable <- liftIO $ findObjectLinkable this_mod obj_fn obj_date
compile_it_discard_iface (Just linkable)
- _otherwise ->
- compile_it Nothing
+ _otherwise -> do
+ liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
+ (text "compiling mod:" <+> ppr this_mod_name)
+ compile_it Nothing
type SummaryNode = (ModSummary, Int, [Int])
topSortModuleGraph
- :: Bool -- Drop hi-boot nodes? (see below)
+ :: Bool
+ -- ^ Drop hi-boot nodes? (see below)
-> [ModSummary]
-> Maybe ModuleName
-> [SCC ModSummary]
--- Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
+-- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
-- The resulting list of strongly-connected-components is in topologically
-- sorted order, starting with the module(s) at the bottom of the
-- dependency graph (ie compile them first) and ending with the ones at
--
-- Drop hi-boot nodes (first boolean arg)?
--
--- False: treat the hi-boot summaries as nodes of the graph,
+-- - @False@: treat the hi-boot summaries as nodes of the graph,
-- so the graph must be acyclic
--
--- True: eliminate the hi-boot nodes, and instead pretend
+-- - @True@: eliminate the hi-boot nodes, and instead pretend
-- the a source-import of Foo is an import of Foo
-- The resulting graph has no hi-boot nodes, but can be cyclic
if exists
then summariseFile hsc_env old_summaries file mb_phase
obj_allowed maybe_buf
- else throwErrMsg $ mkPlainErrMsg noSrcSpan $
+ else throwOneError $ mkPlainErrMsg noSrcSpan $
text "can't find file:" <+> text file
getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf)
= do maybe_summary <- summariseModule hsc_env old_summary_map False
(dflags', hspp_fn, buf)
<- preprocessFile hsc_env file mb_phase maybe_buf
- (srcimps,the_imps, L _ mod_name) <- liftIO $ getImports dflags' buf hspp_fn file
+ (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
-- Make a ModLocation for this file
location <- liftIO $ mkHomeModLocation dflags mod_name file
-- Preprocess the source file and get its imports
-- The dflags' contains the OPTIONS pragmas
(dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf
- (srcimps, the_imps, L mod_loc mod_name) <- liftIO $ getImports dflags' buf hspp_fn src_fn
+ (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
when (mod_name /= wanted_mod) $
- throwErrMsg $ mkPlainErrMsg mod_loc $
+ throwOneError $ mkPlainErrMsg mod_loc $
text "File name does not match module name:"
$$ text "Saw:" <+> quotes (ppr mod_name)
$$ text "Expected:" <+> quotes (ppr wanted_mod)
--
(dflags', leftovers, warns)
<- parseDynamicNoPackageFlags dflags local_opts
- liftIO $ checkProcessArgsResult leftovers -- XXX: throws exceptions
- liftIO $ handleFlagWarnings dflags' warns -- XXX: throws exceptions
+ checkProcessArgsResult leftovers
+ handleFlagWarnings dflags' warns
let
needs_preprocessing
noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
-- ToDo: we don't have a proper line number for this error
noModError dflags loc wanted_mod err
- = throwErrMsg $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
+ = throwOneError $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
-noHsFileErr :: SrcSpan -> String -> a
+noHsFileErr :: GhcMonad m => SrcSpan -> String -> m a
noHsFileErr loc path
- = throwErrMsg $ mkPlainErrMsg loc $ text "Can't find" <+> text path
+ = throwOneError $ mkPlainErrMsg loc $ text "Can't find" <+> text path
-packageModErr :: ModuleName -> a
+packageModErr :: GhcMonad m => ModuleName -> m a
packageModErr mod
- = throwErrMsg $ mkPlainErrMsg noSrcSpan $
+ = throwOneError $ mkPlainErrMsg noSrcSpan $
text "module" <+> quotes (ppr mod) <+> text "is a package module"
multiRootsErr :: [ModSummary] -> IO ()
multiRootsErr [] = panic "multiRootsErr"
multiRootsErr summs@(summ1:_)
- = throwErrMsg $ mkPlainErrMsg noSrcSpan $
+ = throwOneError $ mkPlainErrMsg noSrcSpan $
text "module" <+> quotes (ppr mod) <+>
text "is defined in multiple files:" <+>
sep (map text files)
-- 'setContext'.
lookupGlobalName :: GhcMonad m => Name -> m (Maybe TyThing)
lookupGlobalName name = withSession $ \hsc_env -> do
- eps <- liftIO $ readIORef (hsc_EPS hsc_env)
- return $! lookupType (hsc_dflags hsc_env)
- (hsc_HPT hsc_env) (eps_PTE eps) name
+ liftIO $ lookupTypeHscEnv hsc_env name
+
+findGlobalAnns :: (GhcMonad m, Typeable a) => ([Word8] -> a) -> AnnTarget Name -> m [a]
+findGlobalAnns deserialize target = withSession $ \hsc_env -> do
+ ann_env <- liftIO $ prepareAnnotations hsc_env Nothing
+ return (findAnns deserialize ann_env target)
#ifdef GHCI
-- | get the GlobalRdrEnv for a session
#endif
-- -----------------------------------------------------------------------------
+
+-- | Return all /external/ modules available in the package database.
+-- Modules from the current session (i.e., from the 'HomePackageTable') are
+-- not included.
+packageDbModules :: GhcMonad m =>
+ Bool -- ^ Only consider exposed packages.
+ -> m [Module]
+packageDbModules only_exposed = do
+ dflags <- getSessionDynFlags
+ let pkgs = UFM.eltsUFM (pkgIdMap (pkgState dflags))
+ return $
+ [ mkModule pid modname | p <- pkgs
+ , not only_exposed || exposed p
+ , pid <- [mkPackageId (package p)]
+ , modname <- exposedModules p ]
+
+-- -----------------------------------------------------------------------------
-- Misc exported utils
dataConType :: DataCon -> Type