Linking to Haskell code from an external program

Colin Paul Adams colin at colina.demon.co.uk
Sat Nov 15 08:16:27 EST 2008


Embarassing - I simply forgot to include Fib.o in the link.
So it links now (program crashes, but I can try to sort that out).

I'm still intereted in knowing how to automatically get the list of
required libraries.
>>>>> "Colin" == Colin Paul Adams <colin at colina.demon.co.uk> writes:

    Colin> I am trying to call a Haskell function from an Eiffel
    Colin> program, using C as an intermediary.

    Colin> For starters, I compiled and ran a variation of the program
    Colin> shown in
    Colin> http://haskell.org/haskellwiki/Calling_Haskell_from_C, to
    Colin> make sure I had the C-code right.

    Colin> I then attempted to move it into Eiffel. I can compile the
    Colin> C code OK, but I'm running into problems with linking.

    Colin> I solved most of the problems by adding the -v flag to the
    Colin> call to ghc which I used to link the original (haskell + c
    Colin> only) program, and cut-and-paste the linker options from
    Colin> their into the Eiffel configuration file. This isn't really
    Colin> satisfactory - I would like some automatic way to determine
    Colin> what the flags should be.

    Colin> The remaining problem has me stumped. I am getting the
    Colin> following messages:

    Colin> big_file_C4_c.c:(.text+0x9f4f): undefined reference to
    Colin> `__stginit_Fib' /home/colin/fib/Fib_stub.o: In function
    Colin> `stginit_export_Fib_zdffibonaccizuhszuaQO':
    Colin> Fib_stub.c:(.text+0x5): undefined reference to
    Colin> `Fib_zdffibonaccizuhszuaQO_closure'
    Colin> /home/colin/fib/Fib_stub.o: In function `fibonacci_hs':
    Colin> Fib_stub.c:(.text+0x32): undefined reference to
    Colin> `Fib_zdffibonaccizuhszuaQO_closure'

    Colin> The Haskell code looks like this:


    >> {-# LANGUAGE ForeignFunctionInterface #-}
    >> 
    >> module Fib where
    >> 
    >> import Foreign.C.Types import CString
    >> 
    >> fibonacci :: Int -> String fibonacci n = show (fibs !! n) where
    >> fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
    >> 
    >> fibonacci_hs :: CInt -> IO CString fibonacci_hs = newCString
    >> . fibonacci . fromIntegral
    >> 
    >> foreign export ccall fibonacci_hs :: CInt -> IO CString

    Colin> And the C code (in an Eiffel wrapper) looks like this:

    Colin> haskell_fib (n: INTEGER): POINTER is -- String
    Colin> representation of `n'th Fibonacci number as a string
    Colin> external "C inline use <stdio.h>,%"HsFFI.h%"" alias "[
    Colin> #ifdef __GLASGOW_HASKELL__ #include "Fib_stub.h" extern
    Colin> void __stginit_Fib ( void ); #endif

    Colin>               int argc; char *argv[0]; argc = 0;
    Colin> hs_init(&argc, &argv); #ifdef __GLASGOW_HASKELL__
    Colin> hs_add_root(__stginit_Fib); #endif return
    Colin> (fibonacci_hs($n)); hs_exit(); ]" end

    Colin> I can't find any mention of the word "fibonacci" in the
    Colin> output from the ghc run, and I don't know where this
    Colin> _closure stuff is coming from. Can you help?  -- Colin
    Colin> Adams Preston Lancashire
    Colin> _______________________________________________
    Colin> Glasgow-haskell-users mailing list
    Colin> Glasgow-haskell-users at haskell.org
    Colin> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


-- 
Colin Adams
Preston Lancashire


More information about the Glasgow-haskell-users mailing list