[Haskell-cafe] addFinalizer to which object?

[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)