a FFI example exporting Haskell functions

{-# LANGUAGE ForeignFunctionInterface #-}

module Array where

import Foreign.Ptr
import Foreign.Storable

hs_f_int :: Ptr Int -> IO ()
hs_f_int p = do
    x <- peek p
    let y = x + 1
    poke p y

hs_f_int2 :: Ptr Int -> IO ()
hs_f_int2 p = do
    x <- peek p
    let x' = x + 1
    poke p x'
    y <- peek ((plusPtr p 4) :: Ptr Int)  -- to decide a type
    let y' = y + 1
    poke (plusPtr p 4) y'

hs_f_int3 :: Ptr Int -> IO ()
hs_f_int3 p = do
    x <- peek p
    let x' = x + 1
    poke p x'
    y <- peek (plusPtrInt p 1)
    let y' = y + 1
    poke (plusPtrInt p 1) y'
    z <- peek (plusPtrInt p 2)
    let z' = z + 1
    poke (plusPtrInt p 2) z'

--hs_get_array_int :: Ptr Int -> Int -> IO ()
--hs_get_array_int p n = do

plusPtrInt :: Ptr Int -> Int -> Ptr Int
plusPtrInt p n = plusPtr p (4 * n)

foreign export ccall hs_f_int :: Ptr Int -> IO ()
foreign export ccall hs_f_int2 :: Ptr Int -> IO ()
foreign export ccall hs_f_int3 :: Ptr Int -> IO ()

/* C program calling above code is below */

#include <HsFFI.h>
#ifdef __GLASGOW_HASKELL__
    #include "Array_stub.h"
    extern void __stginit_Array(void);
#endif

#include <stdio.h>

void print_array(int a[], int n);

int main()
{
    int x;
    int *p;
    int a[] = {2, 3, 5, 7, 11, 13, 17, 19, 23, 29};

    hs_init(NULL, NULL);
    #ifdef __GLASGOW_HASKELL__
        hs_add_root(__stginit_Array);
    #endif

    x = 2;
    p = &x;

    printf("%d\n", *p);  // 2
    hs_f_int(p);
    printf("%d\n", *p);  // 3

    print_array(a, sizeof a / sizeof (int));  // 2 3 5 7 11 13 17 19 23 29
    hs_f_int2(a);
    print_array(a, sizeof a / sizeof (int));  // 3 4 5 7 11 13 17 19 23 29

    printf("\n");

    print_array(a, sizeof a / sizeof (int));  // 3 4 5 7 11 13 17 19 23 29
    hs_f_int3(a);
    print_array(a, sizeof a / sizeof (int));  // 4 5 6 7 11 13 17 19 23 29

    hs_exit();
    return 0;
}

void print_array(int a[], int n)
{
    int i;

    for (i = 0; i < n; i++)
        printf("%d ", a[i]);
    printf("\n");
}

# to compile in Windows, type:
>ghc -c Array.hs
>ghc --make -no-hs-main -optc-O main.c Array -o main.exe