Skip to content

Instantly share code, notes, and snippets.

@TerrorJack

TerrorJack/cont.hs

Created Oct 9, 2019
Embed
What would you like to do?
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
import Data.Char
import Data.Time.Clock.POSIX
import qualified DynFlags as GHC
import Foreign
import qualified GHC
import GHC.ForeignPtr
import qualified StringBuffer as GHC
import System.IO.Unsafe
import System.Process
import Control.Monad
import Control.Monad.IO.Class
import System.Process
main :: IO ()
main = do
ghc_libdir <-
reverse . dropWhile isSpace . reverse
<$> readProcess
"ghc"
["--print-libdir"]
""
GHC.defaultErrorHandler GHC.defaultFatalMessager GHC.defaultFlushOut
$ GHC.runGhc (Just ghc_libdir)
$ do
dflags0 <- GHC.getSessionDynFlags
_ <-
GHC.setSessionDynFlags
dflags0
{ GHC.ghcMode = GHC.CompManager,
GHC.ghcLink = GHC.LinkBinary,
GHC.hscTarget = GHC.HscAsm,
GHC.parMakeCount = Just 1
}
liftIO $ BS.writeFile "Main.hs" "main = print 233"
GHC.setTargets [inMemoryMainTarget]
sf <- GHC.load GHC.LoadAllTargets
unless (GHC.succeeded sf) $ fail "FAILED"
liftIO $ callCommand "./Main"
--GHC.setTargets []
--sf <- GHC.load GHC.LoadAllTargets
--unless (GHC.succeeded sf) $ fail "FAILED"
liftIO $ BS.writeFile "Main.hs" "main = print 666"
GHC.setTargets [inMemoryMainTarget]
sf <- GHC.load GHC.LoadAllTargets
unless (GHC.succeeded sf) $ fail "FAILED"
liftIO $ callCommand "./Main"
inMemoryMainTarget :: GHC.Target
inMemoryMainTarget = GHC.Target
{ GHC.targetId = GHC.TargetModule $ GHC.mkModuleName "Main",
GHC.targetAllowObjCode = True,
GHC.targetContents =
Nothing
}
@TerrorJack

This comment has been minimized.

Copy link
Owner Author

@TerrorJack TerrorJack commented Oct 15, 2019

setTargets [] *> load LoadAllTargets expects to return Failed, but cleanup is still properly 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.