Add dynCompileExpr

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 74959fe..5e75793 100644 (file)
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -78,7 +78,7 @@ module GHC (
        RunResult(..),
        runStmt,
        showModule,
        RunResult(..),
        runStmt,
        showModule,

-       compileExpr, HValue,
+       compileExpr, HValue, dynCompileExpr,

        lookupName,
 #endif
 
        lookupName,
 #endif
 

@@ -175,6 +175,7 @@ module GHC (
 
 #ifdef GHCI
 import qualified Linker
 
 #ifdef GHCI
 import qualified Linker

+import Data.Dynamic     ( Dynamic )

 import Linker          ( HValue, extendLinkEnv )
 import TcRnDriver      ( tcRnLookupRdrName, tcRnGetInfo,
                          tcRnLookupName, getModuleExports )
 import Linker          ( HValue, extendLinkEnv )
 import TcRnDriver      ( tcRnLookupRdrName, tcRnGetInfo,
                          tcRnLookupName, getModuleExports )

@@ -230,7 +231,7 @@ import SysTools     ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
                       cleanTempDirs )
 import Module
 import UniqFM
                       cleanTempDirs )
 import Module
 import UniqFM

-import PackageConfig    ( PackageId )
+import PackageConfig    ( PackageId, stringToPackageId )

 import FiniteMap
 import Panic
 import Digraph
 import FiniteMap
 import Panic
 import Digraph

@@ -2021,6 +2022,27 @@ compileExpr s expr = withSession s $ \hsc_env -> do
                  _          -> panic "compileExpr"
 
 -- -----------------------------------------------------------------------------
                  _          -> 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
 -- running a statement interactively
 
 data RunResult