calling haskell from C from haskell

Arjen Hommersom arjenh@chello.nl
Fri, 03 Jan 2003 15:38:49 +0100


Hello,

Is calling haskell from C from haskell possible? This is what i tried 
(generated with green-card):

{-# OPTIONS -#include "Main_stub.h" #-}
module Main where

import StdDIS

foreign export ccall foo :: Int -> Int

foo i = i+1

bar :: Int -> IO Int
bar arg1 =
   _casm_ ``do {int arg1;int res1;
                arg1 = (int)%0;
                do { res1 = foo(arg1);
                     printf("Result = %%d\n", res1);
                     %r = (int)(res1);} while(0);
                   } while(0);'' arg1
   >>= \  res1  -> (return (res1))

main = do i <- bar 1
           putStrLn (show i)

Compiling it with:
ghc -fglasgow-exts -package lang -fvia-C -c Main.hs
ghc -o test -package lang Main.o Main_stub.o StdDIS.o

results in:
$ ./test
Result = 2
Segmentation fault

compiling it with some variation of startupHaskell() and 
shutdownHaskell() does not seem to help.

Regards,

Arjen Hommersom