Extracting STG of Haskell Source - haskell

Question

I am trying to extract the STG representation of a Haskell source as a String via Outputable, but it looks like coreToStgArgs is panicing with the following dump:
user#machine ~/Desktop/hue $ runhaskell test.hs
[foo :: forall a. Num a => a -> a
[GblId, Arity=2, Caf=NoCafRefs, Str=DmdType] =
\r srt:SRT:[] [$dNum a1] + $dNum a1 a1;,
bar :: Int -> Int
[GblId,test.hs: test.hs: panic! (the 'impossible' happened)
(GHC version 7.10.3 for x86_64-unknown-linux):
coreToStgArgs I# 3
Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug
Here is the file FooBar.hs that I want to extract:
module FooBar where
foo a = a + a
bar :: Int -> Int
bar b = b + 3
Here is the source of test.hs that I used:
import CoreToStg
import GHC
import GHC.Paths
import Outputable
import StgSyn
mkDynFlags :: IO DynFlags
mkDynFlags = runGhc (Just libdir) getSessionDynFlags
mkSTG :: FilePath -> FilePath -> IO [StgBinding]
mkSTG proj src = do
dflags <- mkDynFlags
ghc_core <- runGhc (Just libdir) $ do
setSessionDynFlags (dflags {importPaths = [proj]})
compileToCoreSimplified src
-- compileToCoreModule src
coreToStg dflags (cm_module ghc_core) (cm_binds ghc_core)
mkIOStr :: (Outputable a) => a -> IO String
mkIOStr obj = do
dflags <- mkDynFlags
let ppr_str = showPpr dflags obj
return ppr_str
main :: IO ()
main = do
let proj = "/home/user/Desktop/hue"
let src = proj ++ "/FooBar.hs"
res <- mkIOStr =<< mkSTG proj src
putStrLn res
It looks like someone several years before me has run into a similar problem:
https://ghc.haskell.org/trac/ghc/ticket/7159
However, I have no idea what has happened since. I am also not sure if this is the correct way to go about extracting the STG of an arbitrary Haskell source, so if there are better alternatives that work, I would like to hear about them.
EDIT:
STG translation appears successful for the following program where bar b = b + 3 is changed to bar b = 3:
module FooBar where
foo a = a + a
bar :: Int -> Int
bar b = 3
In fact, at first glance, things appear to work if the induced Core Haskell does not force primitive operations to be performed. For instance bar b = 3 + 9 fails.

Answer 1

Many thanks to melpomene for pointing out something I missed in the documentation.
Here is the modified source of the test.hs that works:
import CorePrep
import CoreToStg
import GHC
import GHC.Paths
import GhcMonad
import HscTypes
import Outputable
import StgSyn
import System.IO
mkSTG :: FilePath -> FilePath -> IO [StgBinding]
mkSTG proj src = runGhc (Just libdir) $ do
env <- getSession
dflags <- getSessionDynFlags
setSessionDynFlags (dflags {importPaths = [proj]})
target <- guessTarget src Nothing
setTargets [target]
load LoadAllTargets
mod_graph <- getModuleGraph
let mod_sum = head mod_graph -- This is bad practice
pmod <- parseModule mod_sum
tmod <- typecheckModule pmod
dmod <- desugarModule tmod
let guts = coreModule dmod
let loc = ms_location mod_sum
let binds = mg_binds guts
let tcs = mg_tcs guts
prep <- liftIO $ corePrepPgm env loc binds tcs
liftIO $ coreToStg dflags (mg_module guts) prep
mkIOStr :: (Outputable a) => a -> IO String
mkIOStr obj = do
dflags <- runGhc (Just libdir) getSessionDynFlags
let ppr_str = showPpr dflags obj
return ppr_str
main :: IO ()
main = do
let proj = "/home/celery/Desktop/hue"
let src = proj ++ "/FooBar.hs"
res <- mkIOStr =<< mkSTG proj src
putStrLn res
I am not sure what the best way to recover a ModSummary (and hence the ModuleName) from a Target is, but I do vaguely remember it being the first element of the ModuleGraph, which is defined as type ModuleGraph = [ModSummary].
The type signature for corePrepPgm is also different between GHC 7 and 8:
https://downloads.haskell.org/~ghc/7.10.1/docs/html/libraries/ghc-7.10.1/CorePrep.html
https://downloads.haskell.org/~ghc/latest/docs/html/libraries/ghc-8.0.1/CorePrep.html
Suggestions for improvement are welcome :)
EDIT: I have found instances of counter examples to this -- the head of a ModuleGraph is not always the target. My current workaround is to see if any ModSummary within the ModuleGraph contains a location which matches that of the initial source file location.