blob: eba782e636f7c6d4f449991727d13516f09a42a5 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
{-# LANGUAGE EmptyDataDecls, ForeignFunctionInterface #-}
module Main(main) where
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.C
data FnBlob
foreign import ccall "&free_fn_blob" free_fn_blob :: FunPtr (Ptr FnBlob -> IO ())
foreign import ccall safe "call_fn_blob" call_fn_blob :: Ptr FnBlob -> CDouble -> CDouble
type DoubleFn = CDouble -> CDouble
foreign import ccall unsafe "create_fn_blob" create_fn_blob :: FunPtr DoubleFn -> FunPtr (FunPtr DoubleFn -> IO ()) -> IO (Ptr FnBlob)
foreign import ccall unsafe "&freeHaskellFunctionPtr" free_fun_ptr :: FunPtr (FunPtr DoubleFn -> IO())
foreign import ccall "wrapper" wrapDoubleFn :: DoubleFn -> IO (FunPtr DoubleFn)
createFnBlob :: DoubleFn -> IO (ForeignPtr FnBlob)
createFnBlob dfn = do
dfn_ptr <- wrapDoubleFn dfn
ptr_fnblob <- create_fn_blob dfn_ptr free_fun_ptr
newForeignPtr free_fn_blob ptr_fnblob
callFnBlob :: ForeignPtr FnBlob -> CDouble -> IO (CDouble)
callFnBlob fnblob d = withForeignPtr fnblob $
\ptrblob -> return $! call_fn_blob ptrblob d
main = do
putStrLn "start"
step 0
putStrLn "done"
step n | n > 1000 = return ()
step n = do
fnBlob <- createFnBlob (+ n)
result <- callFnBlob fnBlob 0
putStrLn $ "step " ++ show n ++ ": " ++ show result
step (n + 1)
|
