Factorial.hs

{-# 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