C言語からのHaskell関数の呼び出し

まずは、簡単な呼び出し。
一応、ポインタで引き渡した領域に出力データを書いている

CC = gcc
HC = ghc
RM = rm -f
TARGET = test

C_SRC  = main.c
HS_SRC = fib.hs

SRCS = $(C_SRC) $(HS_SRC)
OBJS = $(C_SRC:.c=.o) $(HS_SRC:.hs=.o)

CFLAGS = -Wall

all: $(OBJS)
	$(HC) --make -no-hs-main main.o fib.o -o $(TARGET)

main.o: main.c fib_stub.h
	$(CC) $(CFLAGS) -I`ghc --print-libdir`/include -c $< -o $@

fib_stub.h: fib.o

fib.o: fib.hs
	$(HC) $<

clean:
	$(RM) *.o *.hi *_stub.h *~ $(TARGET)

呼び出される側のHaskellのコード
*_stub.hと言うC言語向けのHeaderがexport宣言で生成される。

Module Fib where

import Foreign.C
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal

{- Cから呼ばれる関数を宣言 -}
foreign export ccall fib :: CUInt -> IO CUInt
foreign export ccall fiblist :: CUInt -> Ptr CUInt -> IO CInt

fib :: CUInt -> IO CUInt
fib n = return (fib' 1 1 0)
    where
      fib' :: CUInt -> CUInt -> CUInt -> CUInt
      fib' counter a2 a1
          | n == 0 = 0
          | counter == n = a2
          | otherwise = fib' (counter + 1) (a2 + a1) a2

fiblist :: CUInt -> Ptr CUInt -> IO CInt
fiblist n ptrResultList = do
  let results = fiblist' 1 [0, 1] 
  {- ポインタで渡された領域に結果を書き込む -}
  pokeArray ptrResultList results
  return (fromIntegral n)
    where
      fiblist' :: Int -> [CUInt] -> [CUInt]
      fiblist' counter fibs 
          | n == 0 = [0]
          | n == fromIntegral counter = fibs
          | otherwise = fiblist' (counter+1) (fibs ++ [(fibs !! counter) + (fibs !! (counter-1))])

呼び出した側のC

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include "fib_stub.h"

int main(int argc, char *argv[]){	
	unsigned int i,list[12]; 
	int hsArgc = 1;
	char *hsArgv[] = { argv[0], NULL };
	char **pHsArgv = hsArgv;

	/* 
	   hsArgv[] = { "+RTS", ... , "-RTS" }
	   とかして、性能の統計情報を取る。
	*/

	hs_init(&hsArgc, &pHsArgv);
	printf("fib = %lu\n", fib(6));

	memset(list, 0xDE, sizeof(list));
	fiblist(sizeof(list)/sizeof(list[0]), list);
	
	for(i=0;i<sizeof(list)/sizeof(list[0]);i++){
		printf("%u ",list[i]);
	}
	printf("\n");

	hs_exit();

	return 0;
}