Skip to content

Instantly share code, notes, and snippets.

@clojj
Created November 7, 2018 08:16
Show Gist options
  • Save clojj/60222564df5956847f3208322f29301c to your computer and use it in GitHub Desktop.
Save clojj/60222564df5956847f3208322f29301c to your computer and use it in GitHub Desktop.
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment