RunResult(..),
runStmt,
showModule,
- compileExpr, HValue,
+ compileExpr, HValue, dynCompileExpr,
lookupName,
#endif
#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 )
+import SysTools ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
+ cleanTempDirs )
import Module
import UniqFM
-import PackageConfig ( PackageId )
+import PackageConfig ( PackageId, stringToPackageId )
import FiniteMap
import Panic
import Digraph
import Util
import StringBuffer ( StringBuffer, hGetStringBuffer )
import Outputable
-import SysTools ( cleanTempFilesExcept )
import BasicTypes
import TcType ( tcSplitSigmaTy, isDictTy )
import Maybes ( expectJust, mapCatMaybes )
-- 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
+ -- 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
-- | Initialises GHC. This must be done /once/ only. Takes the
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