2
votes

I am new to Haskell programming, Foreign Function Interface and Stackoverflow. I am trying to build a Haskell FFI binding for a C based library. Please find below a hypothetical example which is very similar to my current problem:

Consider I have a C struct and a function like this:

typedef struct {
      int someInt;
      void *someInternalData;
   } opaque_t;

int bar (opaque_t *aPtr, int anArg);

The opaque C structure is the out parameter here. I should pass on the same to other APIs. The caller need not de-reference the opaque struct.

Find below myFFI.hsc file with FFI imports:

{-# LANGUAGE CPP, ForeignFunctionInterface #-}
module MyFFI where
import Foreign
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.C.Types
import Foreign.C
import System.IO.Unsafe
import Foreign.Marshal
import qualified Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
import qualified System.IO (putStrLn)

#include "myclib.h"

newtype OpaquePtr = OpaquePtr (ForeignPtr OpaquePtr)

#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) 
instance Storable OpaquePtr where
    sizeOf _ = #{size opaque_t}
    alignment _ = #{alignment opaque_t}
    peek _ = error "Cant peek"

foreign import ccall unsafe "myclib.h bar"
    c_bar :: Ptr OpaquePtr
                -> CInt
                -> CInt

barWrapper :: Int -> (Int, ForeignPtr OpaquePtr)
barWrapper anArg = System.IO.Unsafe.unsafePerformIO $ do
    o <- mallocForeignPtr
    let res = c_bar (fromIntegral anArg) (Foreign.ForeignPtr.Unsafe.unsafeForeignPtrToPtr o)
    return ((fromIntegral res), o)

In my actual code, similar implementation of the above seems to work. But when I pass around the opaque struct reference, I am getting weird output and some times the ghci crases.

I am not sure about the usage of mallocForeignPtr and ForeignPtr in FFI call. For a long living reference we should use ForeignPtr + mallocForeignPtr, but we cannot pass a ForeignPtr in a ccall. How to do it then? Is my above logic correct? Any kind of help would be really great. Thanks.

2

2 Answers

4
votes

I tried to come up with an example that could show a typical usage case. Since there's a long established tradition of using factorials as examples of functional languages, I decided not to break it.

These two files below (factorial.h and factorial.c) use a table to help calculating factorials of integer numbers. They first build and fill a table with factorials; then this table is used to ask for factorials; and then it's deallocated when it's not needed anymore. We also print messages to stdout just to be able to know when our table is initialized and freed.

factorial.h:

/* A table of factorials. table[i] is the factorial of i. The
 * max field is calculated so that its factorial would not be an
 * integer overflow.
 */

typedef struct {
    unsigned max;
    unsigned *table;
} factorial_table;

int factorial_table_init(factorial_table *t);
int factorial_get(factorial_table *t, int n);
void factorial_table_free(factorial_table *t);

factorial.c:

#include <stdio.h>
#include <stdlib.h>
#include <limits.h>
#include <factorial.h>

/* Calculates max and allocate table. Returns !0 if
 * memory could not be allocated.
 */

int factorial_table_init(factorial_table *t)
{
    unsigned i, factorial;

    t->max = factorial = 1;
    while (INT_MAX / factorial > t->max + 1)
        factorial *= ++t->max;
    t->table = malloc((t->max + 1)*sizeof(unsigned));
    if (!t->table) return !0;
    t->table[0] = 1;
    for (i = 1; i <= t->max; i++)
        t->table[i] = i * t->table[i-1];
    fprintf(stdout,"A factorial table was just allocated.\n");
    return 0;
}

/* Uses a table to get the factorial of an integer number n. Returns
 * (-1) if n is negative and (-2) if n is too big.
 */

int factorial_get(factorial_table *t, int n)
{
    if (n < 0) return (-1);    
    if (n > t->max) return (-2);
    return t->table[n];
}

/* Frees the table we used. */

void factorial_table_free(factorial_table *t)
{
    free(t->table);
    fprintf(stdout,"A factorial table was just freed.\n");
}

Now, our Haskell code.

{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}

#include <factorial.h>

#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) 

module Factorial (factorial) where
import Control.Monad
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.C
import Foreign.Storable
import System.IO.Unsafe
import Foreign.Marshal

data Factorial_table

instance Storable Factorial_table where
    sizeOf _ = #{size factorial_table}
    alignment _ = #{alignment factorial_table}
    peek _ = error "Cant peek"

foreign import ccall factorial_table_init :: Ptr Factorial_table -> IO CInt
foreign import ccall factorial_get :: Ptr Factorial_table -> CInt -> IO CInt
foreign import ccall "&factorial_table_free" funptr_factorial_table_free
    :: FunPtr (Ptr Factorial_table -> IO ())

factorialIO :: IO (CInt -> IO CInt)
factorialIO = do
    tableFgnPtr <- mallocForeignPtr :: IO (ForeignPtr Factorial_table)
    withForeignPtr tableFgnPtr $ \ptr -> do
        status <- factorial_table_init ptr
        when (status /= 0) $ fail "No memory for factorial table"
    addForeignPtrFinalizer funptr_factorial_table_free tableFgnPtr
    let factorialFunction n = do
        r <- withForeignPtr tableFgnPtr $ \ptr -> factorial_get ptr n
        when (r == (-1)) $ fail
            "Factorial was requested for a negative number"
        when (r == (-2)) $ fail
            "Factorial was requested for a number that is too big"
        return r
    return factorialFunction

factorial :: CInt -> CInt
factorial = unsafePerformIO . unsafePerformIO factorialIO

First, note how Factorial_table instances Storable. Also note that all function bindings return IOs.

All relevant code is in factorialIO. It first mallocs a pointer (and here is where size and alignment information from Storable is used. I wrote the type of that call, but that is not necessary). Then it adds the finalizer, which will be run just before that pointer memory is freed. We encapsulate that pointer inside a function of an integer (factorialFunction), always using withForeignPtr, and return it.

Since we know our functions do not have important side effects, the last 2 lines just make what we just created into a pure function. Let's test it:

ghci
    Prelude> :m + Factorial 
Prelude Factorial> factorial 5
    A factorial table was just allocated.
    120
Prelude Factorial> factorial 10
    3628800
Prelude Factorial> factorial 13
    *** Exception: user error (Factorial was requested for a number that is too big)
Prelude Factorial> factorial 12
    479001600
Prelude Factorial> :q
    Leaving GHCi.
    A factorial table was just freed.

I hope this was useful. Of course, it's a completely artificial way of calculating factorials, but that is what God created factorials for.

0
votes

Well, I think I found a solution with proper usage of ForeignPtr and mallocForeignPtr:

barWrapper :: Int -> (Int, Either error (ForeignPtr OpaquePtr))
barWrapper anArg = System.IO.Unsafe.unsafePerformIO $ do
    o <- mallocForeignPtr
    withForeignPtr o $ \opaque_ptr -> do
        let res = c_bar (fromIntegral anArg) opaque_ptr
        if res /= (-1)
            then return ((fromIntegral res), Right o)
        else
            return ((fromIntegral res), Left $ error "some problem")

The issues were:

  1. I overlook the lazy evaluation thingy of Haskell : only on accessing the 'res' the foreign call will be executed. So, I had to use a if / else block to make it call the ccall
  2. I should be using withForeignPtr instead of unsafeForeignPtrtoPtr