
so I am trying to figure out how to use ghc as a library. following this example, http://www.haskell.org/haskellwiki/GHC/As_a_library, i can load a module and examine its symbols: module Main where import GHC import GHC.Paths ( libdir ) import DynFlags ( defaultDynFlags ) import System.Environment import Data.Maybe import Outputable main = do args <- getArgs let file = head $ args rv <- defaultErrorHandler defaultDynFlags $ do runGhc (Just libdir) $ do dflags <- getSessionDynFlags setSessionDynFlags dflags target <- guessTarget file Nothing setTargets [target] load LoadAllTargets gr <- getModuleGraph mi <- getModuleInfo $ ms_mod $ head $ gr return $ fromJust $ mi print $ showSDoc $ ppr $ modInfoInstances $ rv print $ showSDoc $ ppr $ modInfoExports $ rv given Test.hs: module Test where hello = "hello" world = "world" one = 1 two = 2 i get this output: $ ./Main ./Test.hs "[]" "[Test.hello, Test.one, Test.two, Test.world]" which is what i expect. My question is, how do manipulate the symbols exported by Test? Is there a way to test the types? lets say i wanted to sum all the numbers and concatenate all the strings in Test.hs, how would i do that?

On Oct 25, 2008, at 8:39 PM, Anatoly Yakovenko wrote:
so I am trying to figure out how to use ghc as a library. following this example, http://www.haskell.org/haskellwiki/GHC/As_a_library, i can load a module and examine its symbols: [...]
given Test.hs:
module Test where
hello = "hello" world = "world" one = 1 two = 2
i get this output:
$ ./Main ./Test.hs "[]" "[Test.hello, Test.one, Test.two, Test.world]"
which is what i expect. My question is, how do manipulate the symbols exported by Test? Is there a way to test the types? lets say i wanted to sum all the numbers and concatenate all the strings in Test.hs, how would i do that?
Hi, Anatoly Sorry for don't answering your question in the first place, but for this kind of tasks I believe you might be better off using some lightweight wrapper of the GHC Api. For instance, using http://hackage.haskell.org/cgi-bin/hackage-scripts/package/hint you write: import Language.Haskell.Interpreter.GHC import Control.Monad.Trans ( liftIO ) import Control.Monad ( filterM ) test_module = "Test" main :: IO () main = do s <- newSession withSession s $ do loadModules [test_module] -- loads Test.hs... setTopLevelModules [test_module] -- ...and puts it in scope setImports ["Prelude"] -- put the Prelude in scope too -- exports <- getModuleExports "Test" -- get Test's symbols let ids = [f | Fun f <- exports] -- strings <- filterM (hasType "[Char]") ids conc <- concat `fmap` mapM (\e -> interpret e infer) strings liftIO $ putStrLn conc -- ns <- filterM (hasType "Integer") ids sum_ns <- sum `fmap` mapM (\e -> interpret e (as :: Integer)) ns liftIO $ putStrLn (show sum_ns) hasType :: String -> Id -> Interpreter Bool hasType t e = do type_of_e <- typeOf e return (type_of_e == t) $ ./Main helloworld 3 The version in hackage of hint works only with GHC 6.6.x and 6.8.x, mind you, but a new version is coming soon.... Good luck, Daniel

Hi, Anatoly
Sorry for don't answering your question in the first place, but for this kind of tasks I believe you might be better off using some lightweight wrapper of the GHC Api.
thanks, that's really cool, but I am trying to figure out a way to embed haskell into another program so i can control and configure it using haskell. I managed to get farther by using the GHC api's that manipulate the ModuleInfo structure, but I am kind of stuck right now trying to figure out how to allow different scripts import each other. The problem is that i dont wan't to have to structure the input scripts as I would a regular haskell project. I basically want to be able to do import "foo/blah.hs" and read the blah.hs file directly. Any ideas?

I'm not quite sure what you are trying to do. But for what it's
worth, you can load a specific file via
setTarget [Target (TargetFile "foo/blah.hs") True Nothing]
see http://code.haskell.org/~nominolo/html/ghc/GHC.html#v%3AsetTargets
Here're GHC's current haddocks (for HEAD):
http://code.haskell.org/~nominolo/html/ghc/frames.html
2008/10/27 Anatoly Yakovenko
Hi, Anatoly
Sorry for don't answering your question in the first place, but for this kind of tasks I believe you might be better off using some lightweight wrapper of the GHC Api.
thanks, that's really cool, but I am trying to figure out a way to embed haskell into another program so i can control and configure it using haskell. I managed to get farther by using the GHC api's that manipulate the ModuleInfo structure, but I am kind of stuck right now trying to figure out how to allow different scripts import each other.
The problem is that i dont wan't to have to structure the input scripts as I would a regular haskell project. I basically want to be able to do
import "foo/blah.hs"
and read the blah.hs file directly. Any ideas? _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On Mon, Oct 27, 2008 at 3:27 AM, Thomas Schilling
I'm not quite sure what you are trying to do. But for what it's worth, you can load a specific file via
setTarget [Target (TargetFile "foo/blah.hs") True Nothing]
right, but I cant do that from inside a module in place of an import. Is there any way to for me to somehow tell ghc, or my wrapper, that I want to load a module from a specific directory, regardless of what the current include flags are? Anatoly

Not at the moment. I was thinking about abstracting out the finder,
which might be useful for other things, too. Can you maybe describe
your actual goal? Adding an import "foo/bar" would not parse, so you
must have some kind of preprocessing going on, so you might be able to
insert some dummy imports there which you then have to provide. E.g.:
import "foo/bar.hs" ~~> import CafeF00d.Foo.Bar, and you then copy (or
symlink) foo/bar.hs to CafeF00d/Foo/Bar.hs. You can put those into a
special directory which you prepend to the list of searched
directories.
I still can't see a good use case for this, though.
2008/10/27 Anatoly Yakovenko
On Mon, Oct 27, 2008 at 3:27 AM, Thomas Schilling
wrote: I'm not quite sure what you are trying to do. But for what it's worth, you can load a specific file via
setTarget [Target (TargetFile "foo/blah.hs") True Nothing]
right, but I cant do that from inside a module in place of an import. Is there any way to for me to somehow tell ghc, or my wrapper, that I want to load a module from a specific directory, regardless of what the current include flags are?
Anatoly

On Mon, Oct 27, 2008 at 3:23 PM, Thomas Schilling
Not at the moment. I was thinking about abstracting out the finder, which might be useful for other things, too. Can you maybe describe your actual goal? Adding an import "foo/bar" would not parse, so you must have some kind of preprocessing going on, so you might be able to insert some dummy imports there which you then have to provide. E.g.: import "foo/bar.hs" ~~> import CafeF00d.Foo.Bar, and you then copy (or symlink) foo/bar.hs to CafeF00d/Foo/Bar.hs. You can put those into a special directory which you prepend to the list of searched directories.
Well my immediate goal was to see if i can make a generic build system ala ruby's rake or rant in haskell. But the overall goal was to understand how the compiler works and what i can do with it. I hate gui's so i prefer having a interface to my programs that's as expressive as the language that they are written in, and being typesafe is always nice :). I think you suggestion on using the preprocessor is an excellent idea, and should at least get me there. Can you point me to some documentation on what gcc expects from the preprocessor? Does it basically expect something that has the same interface as cpp?

GHC contains its own preprocessor, it just needs to be activated using
-cpp on the command line or {-# LANGUAGE CPP #-} inside the file.
However, I wasn't suggesting that. I was suggesting that before you
hand the input to the ghc api, you substitute all occurences of import
"foo" by something that the haskell parser understands.
2008/10/28 Anatoly Yakovenko
On Mon, Oct 27, 2008 at 3:23 PM, Thomas Schilling
wrote: Not at the moment. I was thinking about abstracting out the finder, which might be useful for other things, too. Can you maybe describe your actual goal? Adding an import "foo/bar" would not parse, so you must have some kind of preprocessing going on, so you might be able to insert some dummy imports there which you then have to provide. E.g.: import "foo/bar.hs" ~~> import CafeF00d.Foo.Bar, and you then copy (or symlink) foo/bar.hs to CafeF00d/Foo/Bar.hs. You can put those into a special directory which you prepend to the list of searched directories.
Well my immediate goal was to see if i can make a generic build system ala ruby's rake or rant in haskell. But the overall goal was to understand how the compiler works and what i can do with it. I hate gui's so i prefer having a interface to my programs that's as expressive as the language that they are written in, and being typesafe is always nice :).
I think you suggestion on using the preprocessor is an excellent idea, and should at least get me there. Can you point me to some documentation on what gcc expects from the preprocessor? Does it basically expect something that has the same interface as cpp?

On Tue, Oct 28, 2008 at 2:34 AM, Thomas Schilling
GHC contains its own preprocessor, it just needs to be activated using -cpp on the command line or {-# LANGUAGE CPP #-} inside the file. However, I wasn't suggesting that. I was suggesting that before you hand the input to the ghc api, you substitute all occurences of import "foo" by something that the haskell parser understands.
Thanks a lot for your help. I am trying your suggestion at the moment. Anatoly
participants (3)
-
Anatoly Yakovenko
-
Daniel Gorín
-
Thomas Schilling