{-# LANGUAGE FlexibleContexts #-}
{- |
Adding the finalizer to a ForeignPtr seems to be the only way
that warrants execution of the finalizer (not too early and not never).
However, the normal ForeignPtr finalizers must be independent from Haskell runtime.
In contrast to ForeignPtr finalizers,
addFinalizer adds finalizers to boxes, that are optimized away.
Thus finalizers are run too early or not at all.
Concurrent.ForeignPtr and using threaded execution
is the only way to get finalizers in Haskell IO.
-}
module Synthesizer.LLVM.ForeignPtr where

import qualified LLVM.Extra.Memory as Memory
import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )

import qualified LLVM.ExecutionEngine as EE

import qualified Foreign.Marshal.Utils as Marshal
import qualified Foreign.ForeignPtr as FPtr
import qualified Foreign.Concurrent as FC
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, )
import Foreign.StablePtr (newStablePtr, freeStablePtr)
import Foreign.Storable (Storable, poke, )
import Foreign.Ptr (Ptr, nullPtr, )


newAux :: IO () -> IO (ForeignPtr ())
newAux = FC.newForeignPtr nullPtr


makeFinalizer :: (EE.ExecutionEngine, IO ()) -> IO (IO ())
makeFinalizer (ee, finalizer) = do
   stable <- newStablePtr ee
   return $ finalizer >> freeStablePtr stable

newInit ::
   (EE.ExecutionEngine, Ptr a -> IO ()) -> IO (Ptr a) -> IO (ForeignPtr a)
newInit (ee, stop) start = do
   state <- start
   FC.newForeignPtr state =<< makeFinalizer (ee, stop state)

newParam ::
   (Storable b, MakeValueTuple b, Memory.C (ValueTuple b)) =>
   (EE.ExecutionEngine, Ptr a -> IO ()) ->
   (Ptr (Memory.Struct (ValueTuple b)) -> IO (Ptr a)) ->
   b -> IO (ForeignPtr a)
newParam stop start b =
   newInit stop (Marshal.with b (start . Memory.castTuplePtr))

new :: Storable a => IO () -> a -> IO (ForeignPtr a)
new finalizer a = do
   ptr <- FPtr.mallocForeignPtr
   FC.addForeignPtrFinalizer ptr finalizer
   withForeignPtr ptr (flip poke a)
   return ptr

with ::
   (Storable a, MakeValueTuple a, Memory.C (ValueTuple a)) =>
   ForeignPtr a -> (Ptr (Memory.Struct (ValueTuple a)) -> IO b) -> IO b
with fp func =
   withForeignPtr fp (func . Memory.castTuplePtr)