FFI: FinalizerPtr and freeHaskellFunPtr

Hi, I'm trying to write a binding to a C library, and so far here is the code I have: {-# LANGUAGE ForeignFunctionInterface #-} import Foreign.Ptr import Foreign.ForeignPtr newtype C_mlp_context = C_mlp_context (Ptr C_mlp_context) data MLPContext = MLPContext !(ForeignPtr C_mlp_context) deriving (Show) foreign import ccall "wrapper" makeFinalizer :: (Ptr a -> IO ()) -> IO (FinalizerPtr a) foreign import ccall unsafe "mlp.h mlp_context_new" c_new :: IO (Ptr C_mlp_context) new :: IO MLPContext new = do mlp_context <- c_new fin <- mlp_context_finalizer fctx <- newForeignPtr fin mlp_context return $ MLPContext fctx mlp_context_finalizer :: IO (FinalizerPtr C_mlp_context) mlp_context_finalizer = do makeFinalizer $ \ctx -> do c_delete ctx foreign import ccall unsafe "mlp.h mlp_context_delete" c_delete :: Ptr C_mlp_context -> IO () main = do ctx <- new putStrLn $ show ctx This seems to work as expected, but I read that I'm supposed to call freeHaskellFunPtr on the finalizer when I'm done with it. However I don't know how I can do this since it is called by the GC... Can anyone offer any advice? Thanks, Patrick -- ===================== Patrick LeBoutillier Rosemère, Québec, Canada
participants (1)
-
Patrick LeBoutillier