Using the ghc-api to run more than one instance of ghc simultaneously

[Daniel Gorín]

Hi

I'm trying to use the GHC API to have several instances of GHC's  
interpreter loaded simultaneously; each with its own loaded modules,  
etc. However, this doesn't seem to work well when two instances have  
loaded modules with the same name. I'm including the code of a  
small(ish) example of this at the end of the message.

The example launches two threads (with forkIO) and fires GHC in  
interpreted mode on each thread (with GHC.runGhc); then it  
sequentially loads file TestMain1.hs in the first and TestMain2.hs in  
the second one and finally tries to evaluate expression test1 defined  
in the first one followed by test2 defined in the second one. The  
output is:

#./Main
1: Load succeded
2: Load succeded
3: (1,2,3)
4: Main:
During interactive linking, GHCi couldn't find the following symbol:
   Main_test1_closure
This may be due to you not asking GHCi to load extra object files,
archives or DLLs needed by your current session.  Restart GHCi,  
specifying
the missing library using the -L/path/to/object/dir and -lmissinglibname
flags, or simply by naming the relevant files on the GHCi command line.
Alternatively, this link failure might indicate a bug in GHCi.
If you suspect the latter, please send a bug report to:
   glasgow-haskell-bugs at haskell.org

Main: thread blocked indefinitely
#

The "thread blocked indefinitely" message is not important (comes from  
simplifying the original example). I tried this both in ghc 6.10.1 and  
ghc 6.11.20090607 with the same results.

Is this a known limitation? Or should I be doing it some other way?

Thanks,
Daniel

{-# LANGUAGE MagicHash #-}
module Main where

import Prelude hiding ( init )

import Control.Monad ( join, forever )
import Control.Concurrent ( forkIO )
import Control.Concurrent.Chan


import GHC ( Ghc )
import qualified GHC
import qualified MonadUtils as GHC

import qualified GHC.Paths
import qualified GHC.Exts

main :: IO ()
main = do let test1 = "TestMain1.hs"
           let test2 = "TestMain2.hs"
           writeFile test1 "module Main where test1 = (1,2,3)"
           writeFile test2 "module Main where test1 = (3,2,1)"
           --
           ghc_1 <- newGhcServer
           ghc_2 <- newGhcServer
           line "1" $ runInServer ghc_1 $ load (test1, "Main")
           line "2" $ runInServer ghc_2 $ load (test2, "Main")
           line "3" $ runInServer ghc_1 $ eval "test1"
           line "4" $ runInServer ghc_2 $ eval "test1"
   where line n a = putStr (n ++ ": ") >> a

type ModuleName = String
type GhcServerHandle = Chan (Ghc ())

newGhcServer :: IO GhcServerHandle
newGhcServer = do pChan <- newChan
                   let be_a_server = forever $ join (GHC.liftIO $  
readChan pChan)
                   forkIO $ ghc be_a_server
                   return pChan
   where ghc action = GHC.runGhc (Just GHC.Paths.libdir) (init >>  
action)
         init = do df <- GHC.getSessionDynFlags
                   GHC.setSessionDynFlags df{GHC.ghcMode    =  
GHC.CompManager,
                                             GHC.hscTarget  =  
GHC.HscInterpreted,
                                             GHC.ghcLink    =  
GHC.LinkInMemory,
                                             GHC.verbosity  = 0}


runInServer :: GhcServerHandle -> Ghc a -> IO a
runInServer h action = do me <- newChan
                           writeChan h $ action >>= (GHC.liftIO .  
writeChan me)
                           readChan me


load :: (FilePath,ModuleName) -> Ghc ()
load (f,mn) = do target <- GHC.guessTarget f Nothing
                  GHC.setTargets [target]
                  res <- GHC.load GHC.LoadAllTargets
                  GHC.liftIO $ putStrLn ("Load " ++ showSuccessFlag res)
                  --
                  m <- GHC.findModule (GHC.mkModuleName mn) Nothing
                  GHC.setContext [m] []
     where showSuccessFlag GHC.Succeeded = "succeded"
           showSuccessFlag GHC.Failed    = "failed"

eval :: String -> Ghc ()
eval e = do show_e <- GHC.compileExpr $ "(show ("++ e ++")) :: String"
             GHC.liftIO $ putStrLn (GHC.Exts.unsafeCoerce# show_e)