
I'm trying to run the following code. I'm not at all sure it's correct, it's based off of a bit of poking around in the ghc api. Running it with a command line argument like "show (5 + 2)" gives me a segmentation fault. Poking around with gdb and following the steps at http://hackage.haskell.org/trac/ghc/wiki/Debugging/CompiledCode yields precisely nothing, as even the "disassemble" command complains "No function contains program counter for selected frame." Any ideas? == code == module Main where import GHC import DynFlags import Data.Dynamic import System evalString :: Typeable a => String -> IO (Maybe a) evalString s = defaultErrorHandler defaultDynFlags $ runGhc Nothing $ do dynflags <- getSessionDynFlags setSessionDynFlags $ dynflags target <- guessTarget "Prelude" Nothing setTargets [target] load LoadAllTargets dyn <- dynCompileExpr s return $ fromDynamic dyn main = do (s:_) <- getArgs e <- evalString s putStrLn $ maybe "oops" id e -- Edward Amsden Undergraduate Computer Science Rochester Institute of Technology www.edwardamsden.com

Hi,
The first argument of runGhc takes the directory where GHC's library
are. You can use the ghc-paths module
(http://hackage.haskell.org/package/ghc-paths ) for this.
Just install ghc-paths with cabal, import Ghc.Paths and call runGhc
with (Just libdir), it should get past the segfault.
On Sun, Feb 27, 2011 at 10:51 AM, Edward Amsden
I'm trying to run the following code. I'm not at all sure it's correct, it's based off of a bit of poking around in the ghc api. Running it with a command line argument like "show (5 + 2)" gives me a segmentation fault. Poking around with gdb and following the steps at http://hackage.haskell.org/trac/ghc/wiki/Debugging/CompiledCode yields precisely nothing, as even the "disassemble" command complains "No function contains program counter for selected frame."
Any ideas?
== code == module Main where
import GHC import DynFlags import Data.Dynamic import System
evalString :: Typeable a => String -> IO (Maybe a) evalString s = defaultErrorHandler defaultDynFlags $ runGhc Nothing $ do dynflags <- getSessionDynFlags setSessionDynFlags $ dynflags target <- guessTarget "Prelude" Nothing setTargets [target] load LoadAllTargets
dyn <- dynCompileExpr s return $ fromDynamic dyn
main = do (s:_) <- getArgs e <- evalString s putStrLn $ maybe "oops" id e
-- Edward Amsden Undergraduate Computer Science Rochester Institute of Technology www.edwardamsden.com
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Thanks, that fixed it. Why was it segfaulting on "Nothing" though?
Secondly,
I'd like to get to a GHC session that just has, say, Prelude in scope
so I can use dynCompileExpr with "show" etc, but I cannot figure out
how to bring it into scope. The closest I got was to get GHC
complaining that it was a package module.
On Sun, Feb 27, 2011 at 9:24 AM, Anthonin Bonnefoy
Hi,
The first argument of runGhc takes the directory where GHC's library are. You can use the ghc-paths module (http://hackage.haskell.org/package/ghc-paths ) for this.
Just install ghc-paths with cabal, import Ghc.Paths and call runGhc with (Just libdir), it should get past the segfault.
On Sun, Feb 27, 2011 at 10:51 AM, Edward Amsden
wrote: I'm trying to run the following code. I'm not at all sure it's correct, it's based off of a bit of poking around in the ghc api. Running it with a command line argument like "show (5 + 2)" gives me a segmentation fault. Poking around with gdb and following the steps at http://hackage.haskell.org/trac/ghc/wiki/Debugging/CompiledCode yields precisely nothing, as even the "disassemble" command complains "No function contains program counter for selected frame."
Any ideas?
== code == module Main where
import GHC import DynFlags import Data.Dynamic import System
evalString :: Typeable a => String -> IO (Maybe a) evalString s = defaultErrorHandler defaultDynFlags $ runGhc Nothing $ do dynflags <- getSessionDynFlags setSessionDynFlags $ dynflags target <- guessTarget "Prelude" Nothing setTargets [target] load LoadAllTargets
dyn <- dynCompileExpr s return $ fromDynamic dyn
main = do (s:_) <- getArgs e <- evalString s putStrLn $ maybe "oops" id e
-- Edward Amsden Undergraduate Computer Science Rochester Institute of Technology www.edwardamsden.com
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- Edward Amsden Undergraduate Computer Science Rochester Institute of Technology www.edwardamsden.com

Hi, On 2011-February-27 Sunday 16:20:06 Edward Amsden wrote:
Secondly,
I'd like to get to a GHC session that just has, say, Prelude in scope so I can use dynCompileExpr with "show" etc, but I cannot figure out how to bring it into scope. The closest I got was to get GHC complaining that it was a package module.
I don't know if setContext is the proper/best way to do it, but it seems to work: import GHC import GHC.Paths ( libdir ) import DynFlags ( defaultDynFlags ) import Module(stringToPackageId, mkModuleName) import Data.Dynamic(fromDynamic) import System.Environment evalString s = defaultErrorHandler defaultDynFlags $ do runGhc (Just libdir) $ do dflags <- getSessionDynFlags setSessionDynFlags dflags setContext [] [ (mkModule (stringToPackageId "base") (mkModuleName "Prelude") ,Nothing) ] dyn <- dynCompileExpr s return $ fromDynamic dyn main = do (s:_) <- getArgs e <- evalString s putStrLn $ maybe "oops" id e

That's doing what I want, but I'm not sure why you passed
[(mkModule (stringToPackageId "base") (mkModuleName "Prelude"), Nothing) ]
to setContext. I found that
[mkModule (stringToPackageId "base") (mkModuleName "Prelude")]
matches the type expected by setContext. Perhaps we are using
different api versions? I'm using 6.12.3
2011/2/28 Daniel Schüssler
Hi,
On 2011-February-27 Sunday 16:20:06 Edward Amsden wrote:
Secondly,
I'd like to get to a GHC session that just has, say, Prelude in scope so I can use dynCompileExpr with "show" etc, but I cannot figure out how to bring it into scope. The closest I got was to get GHC complaining that it was a package module.
I don't know if setContext is the proper/best way to do it, but it seems to work:
import GHC import GHC.Paths ( libdir ) import DynFlags ( defaultDynFlags ) import Module(stringToPackageId, mkModuleName) import Data.Dynamic(fromDynamic) import System.Environment
evalString s = defaultErrorHandler defaultDynFlags $ do runGhc (Just libdir) $ do dflags <- getSessionDynFlags setSessionDynFlags dflags setContext [] [ (mkModule (stringToPackageId "base") (mkModuleName "Prelude") ,Nothing) ]
dyn <- dynCompileExpr s return $ fromDynamic dyn
main = do (s:_) <- getArgs e <- evalString s putStrLn $ maybe "oops" id e
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- Edward Amsden Undergraduate Computer Science Rochester Institute of Technology www.edwardamsden.com
participants (3)
-
Anthonin Bonnefoy
-
Daniel Schüssler
-
Edward Amsden