Session,
defaultErrorHandler,
defaultCleanupHandler,
- init, initFromArgs,
newSession,
-- * Flags and settings
DynFlags(..), DynFlag(..), Severity(..), GhcMode(..), HscTarget(..), dopt,
parseDynamicFlags,
- initPackages,
getSessionDynFlags,
setSessionDynFlags,
RunResult(..),
runStmt,
showModule,
- compileExpr, HValue,
+ compileExpr, HValue, dynCompileExpr,
lookupName,
#endif
ToDo:
* inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
- * we need to expose DynFlags, so should parseDynamicFlags really be
- part of this interface?
* what StaticFlags should we expose, if any?
-}
#ifdef GHCI
import qualified Linker
+import Data.Dynamic ( Dynamic )
import Linker ( HValue, extendLinkEnv )
import TcRnDriver ( tcRnLookupRdrName, tcRnGetInfo,
tcRnLookupName, getModuleExports )
import HscMain ( newHscEnv, hscFileCheck, HscChecked(..) )
import HscTypes
import DynFlags
-import SysTools ( initSysTools, cleanTempFiles, cleanTempFilesExcept )
+import SysTools ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
+ cleanTempDirs )
import Module
import UniqFM
-import PackageConfig ( PackageId )
+import PackageConfig ( PackageId, stringToPackageId )
import FiniteMap
import Panic
import Digraph
-- handling, but still get the ordinary cleanup behaviour.
defaultCleanupHandler :: DynFlags -> IO a -> IO a
defaultCleanupHandler dflags inner =
- -- make sure we clean up after ourselves
- later (unless (dopt Opt_KeepTmpFiles dflags) $
- cleanTempFiles dflags)
- -- exceptions will be blocked while we clean the temporary files,
- -- so there shouldn't be any difficulty if we receive further
- -- signals.
- inner
-
-
--- | Initialises GHC. This must be done /once/ only. Takes the
--- TopDir path without the '-B' prefix.
-
-init :: Maybe String -> IO ()
-init mbMinusB = do
- -- catch ^C
- main_thread <- myThreadId
- putMVar interruptTargetThread [main_thread]
- installSignalHandlers
-
- dflags0 <- initSysTools mbMinusB defaultDynFlags
- writeIORef v_initDynFlags dflags0
-
--- | Initialises GHC. This must be done /once/ only. Takes the
--- command-line arguments. All command-line arguments which aren't
--- understood by GHC will be returned.
-
-initFromArgs :: [String] -> IO [String]
-initFromArgs args
- = do init mbMinusB
- return argv1
- where -- Grab the -B option if there is one
- (minusB_args, argv1) = partition (prefixMatch "-B") args
- mbMinusB | null minusB_args
- = Nothing
- | otherwise
- = Just (drop 2 (last minusB_args))
-
-GLOBAL_VAR(v_initDynFlags, error "initDynFlags", DynFlags)
- -- stores the DynFlags between the call to init and subsequent
- -- calls to newSession.
+ -- make sure we clean up after ourselves
+ later (unless (dopt Opt_KeepTmpFiles dflags) $
+ do cleanTempFiles dflags
+ cleanTempDirs dflags
+ )
+ -- exceptions will be blocked while we clean the temporary files,
+ -- so there shouldn't be any difficulty if we receive further
+ -- signals.
+ inner
+
-- | Starts a new session. A session consists of a set of loaded
-- modules, a set of options (DynFlags), and an interactive context.
-- ToDo: GhcMode should say "keep typechecked code" and\/or "keep renamed
-- code".
-newSession :: GhcMode -> IO Session
-newSession mode = do
- dflags0 <- readIORef v_initDynFlags
- dflags <- initDynFlags dflags0
+newSession :: GhcMode -> Maybe FilePath -> IO Session
+newSession mode mb_top_dir = do
+ -- catch ^C
+ main_thread <- myThreadId
+ putMVar interruptTargetThread [main_thread]
+ installSignalHandlers
+
+ dflags0 <- initSysTools mb_top_dir defaultDynFlags
+ dflags <- initDynFlags dflags0
env <- newHscEnv dflags{ ghcMode=mode }
ref <- newIORef env
return (Session ref)
getSessionDynFlags :: Session -> IO DynFlags
getSessionDynFlags s = withSession s (return . hsc_dflags)
--- | Updates the DynFlags in a Session
-setSessionDynFlags :: Session -> DynFlags -> IO ()
-setSessionDynFlags s dflags = modifySession s (\h -> h{ hsc_dflags = dflags })
+-- | Updates the DynFlags in a Session. This also reads
+-- the package database (unless it has already been read),
+-- and prepares the compilers knowledge about packages. It
+-- can be called again to load new packages: just add new
+-- package flags to (packageFlags dflags).
+--
+-- Returns a list of new packages that may need to be linked in using
+-- the dynamic linker (see 'linkPackages') as a result of new package
+-- flags. If you are not doing linking or doing static linking, you
+-- can ignore the list of packages returned.
+--
+setSessionDynFlags :: Session -> DynFlags -> IO [PackageId]
+setSessionDynFlags (Session ref) dflags = do
+ hsc_env <- readIORef ref
+ (dflags', preload) <- initPackages dflags
+ writeIORef ref $! hsc_env{ hsc_dflags = dflags' }
+ return preload
-- | If there is no -o option, guess the name of target executable
-- by using top-level source file name as a base.
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
- = throwDyn $ mkPlainErrMsg loc $ cantFindError dflags wanted_mod err
+ = throwDyn $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
noHsFileErr loc path
= throwDyn $ mkPlainErrMsg loc $ text "Can't find" <+> text path
res <- findImportedModule hsc_env mod_name Nothing
case res of
Found _ m | modulePackageId m /= this_pkg -> return m
- -- not allowed to be a home module
- err -> let msg = cantFindError dflags mod_name err in
+ | otherwise -> throwDyn (CmdLineError (showSDoc $
+ text "module" <+> pprModule m <+>
+ text "is not loaded"))
+ err -> let msg = cannotFindModule dflags mod_name err in
throwDyn (CmdLineError (showSDoc msg))
#ifdef GHCI
_ -> panic "compileExpr"
-- -----------------------------------------------------------------------------
+-- Compile an expression into a dynamic
+
+dynCompileExpr :: Session -> String -> IO (Maybe Dynamic)
+dynCompileExpr ses expr = do
+ (full,exports) <- getContext ses
+ setContext ses full $
+ (mkModule
+ (stringToPackageId "base") (mkModuleName "Data.Dynamic")
+ ):exports
+ let stmt = "let __dynCompileExpr = Data.Dynamic.toDyn (" ++ expr ++ ")"
+ res <- withSession ses (flip hscStmt stmt)
+ setContext ses full exports
+ case res of
+ Nothing -> return Nothing
+ Just (_, names, hvals) -> do
+ vals <- (unsafeCoerce# hvals :: IO [Dynamic])
+ case (names,vals) of
+ (_:[], v:[]) -> return (Just v)
+ _ -> panic "dynCompileExpr"
+
+-- -----------------------------------------------------------------------------
-- running a statement interactively
data RunResult