addFinalizer to which object? (fwd from cafe)

[Henning Thielemann]

The documentation of System.Mem.Weak.addFinalizer suggests to me, that this 
function is very fragile, because the object we track, might be optimized away.
In my case this applies. I have a resource that is needed for generating chunks 
of a lazy byte string. If the byte string is created completely or the byte 
string cannot be accessed anymore, this resource must be freed. It must also be 
freed within Haskell code, thus addForeignPtrFinalizer does not help.
To illustrate that I have attached a small example, where I use a StablePtr as 
resource, that points to a list. This Haskell list is read from C code and 
written to a chunk of a lazy ByteString. A Haskell function creates the 
ByteString lazily and calls the C function for every new chunk. I have added a 
finalizer to the StablePtr itself. That works without optimization, but using 
optimization the finalizer is run immediately and the program aborts with 
segmentation fault.
Thus my question: How to get reliable finalization?
-------------- next part --------------
#include "ProcessList_stub.h"
/*
The function copies elements from a Haskell list to a piece of memory
and returns the number of bytes that could be fetched.
*/
int copy_list_to_chunk (unsigned long int n, HsStablePtr list, char *p) {
   unsigned long int k = n;
   while (k>0) {
      if (!get_next_element(list, p)) {break; }
      p++;
      k--;
   }
   return (n-k);
}
-------------- next part --------------
{-
# generate C stubs
ghc -c ProcessList.hs
# generate executable
ghc -O --make ProcessChunk.c ProcessList.hs
-}

{-
Use a C function for filling chunks of a lazy ByteString
with data from a Haskell list.
A StablePtr is needed to pass the list to C and back to Haskell.
Somehow we must assert that the StablePtr is deleted
and the list can be garbage collected,
once the ByteString is constructed.
We concatenate infinitely many such lists,
thus many StablePtrs and referenced lists must be freed.
Use addFinalizer? To which object shall I add the finalizer?
Without optimization adding the finalizer to the StablePtr works,
with optimization, its finalizer is run too early.
I also tried to add the finalizer to the end of the list,
which is not quite correct,
but then the finalizer is run never.
Whatever I tried: Finalizer is run immediately or never.
What is the right way?
-}

{-# LANGUAGE ForeignFunctionInterface #-}
module Main where

import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Internal as BLI

import System.IO.Unsafe (unsafePerformIO, unsafeInterleaveIO, )
import System.Mem.Weak (addFinalizer, )
import Foreign.StablePtr (StablePtr, newStablePtr, freeStablePtr, deRefStablePtr, )
import Foreign.Storable (poke, )
import Foreign.C.Types (CULong, )
import Foreign.Ptr (FunPtr, Ptr, nullPtr, castPtr, )
import Data.IORef (IORef, newIORef, readIORef, writeIORef, )
import Data.Word (Word8, Word32, )

import Control.Monad (liftM2, )


getNextElement ::
   StablePtr (IORef [Word8]) -> Ptr Word8 -> IO Bool
getNextElement stable elemPtr = do
   listRef <- deRefStablePtr stable
   xt <- readIORef listRef
   case xt of
      [] -> return False
      x:xs -> do
         poke elemPtr x
         writeIORef listRef xs
         return True

foreign export ccall "get_next_element"
   getNextElement :: StablePtr (IORef [Word8]) -> Ptr Word8 -> IO Bool

foreign import ccall "copy_list_to_chunk"
   copyListToChunk :: CULong -> StablePtr (IORef [Word8]) -> Ptr Word8 -> IO CULong


chunkSize :: Int
chunkSize = 13

byteStringFromList :: [Word8] -> BL.ByteString
byteStringFromList list = unsafePerformIO $ do
   stable <- newStablePtr =<< newIORef list
   addFinalizer stable
      (putStrLn "free stable pointer" >> freeStablePtr stable)
   let go =
         unsafeInterleaveIO $ do
            v <- BI.createAndTrim chunkSize $
               fmap fromIntegral .
               copyListToChunk (fromIntegral chunkSize) stable
            fmap (BLI.chunk v) $
               if B.length v < chunkSize
                 then return BL.empty
                 else go
   go


main :: IO ()
main =
   print $ BL.unpack $ -- BL.take 1000 $
   BL.concat $
   map
     (BL.take 42 . byteStringFromList . iterate (1+))
     (iterate (1+) 0)