Here’s a somewhat silly struct that’ll do for this example:

typedef struct {
    int a;
    int b;
} Foo;

It goes the file foo.h. I need some way of making sure that the data was passed properly from Haskell to C so here’s a declaration for a function to print an instance of Foo:

void print_foo(Foo *);

The actual implementation of print_foo goes into foo.c:

void
print_foo(Foo *f)
{
    printf("%s\n", __FUNCTION__);
    printf("f->a: %i\n", f->a);
    printf("f->b: %i\n", f->b);
}

No surprises so far. Now onto the Haskell side of things. First some basic setup:

{-# OPTIONS -ffi #-}
module Main
    where

import Foreign
import Foreign.C.Types

That makes sure I don’t forget to tell GHC that I’m using the foreign function interface (FFI) and imports everything I need for the rest. hsc2hs needs to know about the struct so I simply include the header file. I also need the Haskell representation of Foo, called Bar here, and for convenience I add a type for a pointer to Bar:

#include "foo.h"

data Bar = Bar { a :: Int, b :: Int }
type BarPtr = Ptr (Bar)

Now I’m ready to add the declaration of the “foreign” function:

foreign import ccall "static foo.h print_foo"
    f_print_foo :: BarPtr -> IO ()

Looking through the standard modules it isn’t completely obvious how to create a BarPtr for passing to f_print_foo. Whit the help of people on #haskell I found with, which has the type Storable a => a -> (Ptr a -> IO b) -> IO b. That means I have to make Bar a Storable. According to the documentation on Storable and some experimentation I found that for this particular example I only need full implementations of sizeOf, alignment and poke:

instance Storable Bar where
    sizeOf _ = (#size Foo)
    alignment _ = alignment (undefined :: CInt)
    peek _ = error "peek is not implemented"
    poke ptr (Bar a' b') = do
        (#poke Foo, a) ptr a'
        (#poke Foo, b) ptr b'

([Edited 09-08--2007 07:43 BST] See DeeJay’s comment below for an explanation of the definition of alignment.)

Using with every time I have to call f_print_foo will get tiring so here’s a function that’s a bit more convenient to use:

printFoo b = with b f_print_foo

Now I can write a small main function to test it all:

main = printFoo $ Bar { a=17, b=47 }

It works beautifully. However it’s very limited since it only covers the cases when a C function takes a pointer to a struct as a pure in argument. What about inout? (It’ll be easy to see how to deal with out arguments once the inout case is covered.) So, here’s a C function that adds 1 to one of the members in the struct:

void
add_a(Foo *f)
{
    printf("%s\n", __FUNCTION__);
    f->a++;
}

Of course a declaration in the header file is needed as well, but that’s pretty obvious so I’ll skip it here. The declaration of the foreign function is as simple as for f_print_foo:

foreign import ccall "static foo.h add_a"
    f_add_a :: BarPtr -> IO ()

Now comes the interesting part. Writing a convenience function for f_add_a isn’t as straight forward as for f_print_foo. I think something with the type Bar -> IO Bar would be useful. with creates a temporary BarPtr for the duration of the call which means I have to have an inner function that takes the Bar part out of the BarPtr and returns it inside IO. Luckily peek does exactly that. Adding an implementation of it means that Bar as a Storable is implemented like this:

instance Storable Bar where
    sizeOf _ = (#size Foo)
    alignment _ = 1 -- ???
    peek ptr = do
        a' <- (#peek Foo, a) ptr
        b' <- (#peek Foo, b) ptr
        return Bar { a=a', b=b' }
    poke ptr (Bar a' b') = do
        (#poke Foo, a) ptr a'
        (#poke Foo, b) ptr b'

And the convenience function for f_add_a can be written like this:

addA b = with b $ \ p -> f_add_a p >> peek p

Then I can modify the main function to test this as well:

main = do
    b <- return $ Bar { a=17, b=47 }
    printFoo b
    d <- addA b
    printFoo b
    printFoo d

Indeed, produces the expected out put:

print_foo
f->a: 17
f->b: 47
add_a
print_foo
f->a: 17
f->b: 47
print_foo
f->a: 18
f->b: 47

Pure out arguments can be handled using alloca with a function similar to the one I pass to with in addA above.

Share/Bookmark