Skip to content

Instantly share code, notes, and snippets.

@TerrorJack

TerrorJack/loadX.hs

Created Aug 29, 2019
Embed
What would you like to do?
{-# LANGUAGE GADTs #-}
import Control.Monad
import Control.Monad.IO.Class
import Data.Char
import Data.Foldable
import Data.List
import qualified DynFlags as GHC
import qualified GHC
import qualified GHCi.Message as GHC
import qualified GHCi.RemoteTypes as GHC
import qualified Hooks as GHC
import qualified HscTypes as GHC
import qualified Linker as GHC
import System.Environment.Blank
import System.Process
main :: IO ()
main = do
ks <-
filter (\k -> ("GHC_" `isPrefixOf` k) || "HASKELL_" `isPrefixOf` k)
. map fst
<$> getEnvironment
for_ ks unsetEnv
ghc_libdir <-
reverse . dropWhile isSpace . reverse
<$> readProcess
"ghc"
["--print-libdir"]
""
GHC.defaultErrorHandler GHC.defaultFatalMessager GHC.defaultFlushOut
$ GHC.runGhc (Just ghc_libdir)
$ do
dflags <- GHC.getSessionDynFlags
_ <-
GHC.setSessionDynFlags
$ dflags
{ GHC.ghcLink = GHC.LinkInMemory,
GHC.hooks =
GHC.emptyHooks
{ GHC.startIServHook = Just $ \dflags ->
pure GHC.IServ
{ GHC.iservPipe = error "iservPipe",
GHC.iservProcess = error "iservProcess",
GHC.iservLookupSymbolCache =
error
"iservLookupSymbolCache",
GHC.iservPendingFrees = []
},
GHC.iservCallHook = Just $ \i msg -> do
putStrLn $ "[INFO] " <> show msg
case msg of
GHC.Shutdown -> pure ()
GHC.InitLinker -> pure ()
GHC.LoadDLL _ -> pure Nothing
GHC.LoadObj _ -> pure ()
GHC.AddLibrarySearchPath _ -> pure $ GHC.RemotePtr 0
GHC.RemoveLibrarySearchPath _ -> pure True
GHC.ResolveObjs -> pure True
GHC.FindSystemLibrary lib -> pure $ Just lib,
GHC.stopIServHook = Just $ \_ -> pure ()
}
}
`GHC.gopt_set` GHC.Opt_ExternalInterpreter
GHC.setTargets
[ GHC.Target
{ GHC.targetId = GHC.TargetModule $ GHC.mkModuleName "X",
GHC.targetAllowObjCode = True,
GHC.targetContents = Nothing
}
]
flag <- GHC.load GHC.LoadAllTargets
unless (GHC.succeeded flag) $ fail "GHC.load returned failed"
m <- GHC.findModule (GHC.mkModuleName "X") Nothing
hsc_env <- GHC.getSession
liftIO $ do
putStrLn "[INFO] linkModule start"
GHC.linkModule hsc_env m
putStrLn "[INFO] linkModule done"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.