<div dir="ltr">Hello,<div><br></div><div>I am developing a game and would like to write the core in haskell with haskell also for scripting.  I like haskell.</div><div><br></div><div>I have the following file to help me do this.</div><div><br></div><div>>>> BEGIN FILE</div><div><br></div><div><div>{-# LANGUAGE ScopedTypeVariables #-}</div><div><br></div><div>module Plugin.Load where</div><div><br></div><div>import Data.Functor</div><div>import System.Directory</div><div>import GHC</div><div>import GHC.Paths</div><div>import DynFlags</div><div>import Unsafe.Coerce</div><div><br></div><div>type ModName = String</div><div>type ValName = String</div><div><br></div><div>loadPlugin :: FilePath -> ModName -> ValName -> IO a</div><div>loadPlugin dir modName value = do</div><div>  withCurrentDirectory dir $</div><div>    defaultErrorHandler defaultFatalMessager defaultFlushOut $</div><div>    runGhc (Just libdir) $ do</div><div><br></div><div>    dynFlags <- getSessionDynFlags</div><div>    setSessionDynFlags $ dynamicTooMkDynamicDynFlags $ dynFlags </div><div>      { importPaths = [modName] ++ importPaths dynFlags</div><div>      , hscTarget = HscAsm</div><div>      , ghcLink = LinkInMemory</div><div>      , ghcMode = CompManager</div><div>      }</div><div>    sequence [guessTarget modName Nothing] >>= setTargets</div><div>    load LoadAllTargets</div><div>    setContext [IIDecl $ simpleImportDecl $ mkModuleName modName]</div><div>    fetched <- compileExpr (modName ++ "." ++ value)</div><div>    return (unsafeCoerce fetched :: a)</div></div><div><br></div><div><<< END FILE</div><div><br></div><div>The problem is that if I run the function loadPlugin on the same input more than once, GHC barfs.  The error I get is:</div><div><br></div><div><div>/usr/bin/ld.gold: error: cannot find -lghc_5</div><div>collect2: error: ld returned 1 exit status</div><div>`gcc' failed in phase `Linker'. (Exit code: 1)</div><div>*** Exception: ExitFailure 1</div></div><div><br></div><div>sometimes it's -lghc_2 or -lghc_13 above.  Anyways, it seems like I and/or ghc isn't cleaning up properly after themself and then wants to try to append numbers.  Any idea what is causing this and how to fix it?</div><div><br></div><div>Thanks,</div><div>Matt</div><div><br></div><div>PS. is there a better way of doing this using Typeable?  I'd rather not unsafeCoerce.</div></div>