[Haskell-cafe] FFI woes!

[Robert Dockins]

> Well that shouldn't affect the functionality. The weak pointer was
> only a way of attatching a finalizer to the Playback object. It is
> true that I should probably wrap up the the SoundPlaybackRaw inside
> the SoundPlayback as well, to save CPU, but it shouldn't matter for
> the core functionality.

I'm not sure I understand.

> If I were okay with that I'd just spawn a new one for
> each Playback, which would be considerably cleaner I think than having
> a single loop with some sort of master database of playbacks...

I think both of these are cleaner than starting a new thread at finalize
time.

At any rate, here is a quick hack of mine that I think does what you
want, using a master clean up thread that is only awake when songs are
"playing".  Feel free to play with/use it at will.  Note it doesn't
guarantee that every song is freed.



module Main where

import List
import Monad
import Random

import Foreign
import GHC.ForeignPtr
import System.Mem
import System.Mem.Weak

import Control.Concurrent
import Control.Concurrent.MVar

-- pretend these are foreign imports that really do things...

newSong :: String -> IO (Ptr ())
newSong name = return nullPtr

songDone :: Ptr () -> IO Bool
songDone p = do x <- getStdRandom( randomR (1,100) )
	        if x >= (85::Int)
		   then return True
		   else return False

freeSong :: Ptr () -> IO ()
freeSong p = return ()

--------------------

newtype Song = Song (ForeignPtr ())

data LibState = 
    LibState
    { listMV :: MVar [Ptr ()]
    , waitMV :: MVar Bool
    , killMV :: MVar ()
    }

songFinalizer :: LibState -> Ptr () -> IO ()
songFinalizer libstate p =
  do modifyMVar_ (listMV libstate) (return . (p:))
     tryPutMVar (waitMV libstate) False
     return ()

mkSong :: LibState -> String -> IO Song
mkSong libstate name = 
  do p <- newSong name
     f <- newConcForeignPtr p (songFinalizer libstate p)
     return (Song f)

cleanupThread :: MVar [Ptr ()] -> MVar Bool -> MVar () -> IO ()
cleanupThread listMVar waitMVar killMVar =
   let loop l = 
         do shouldDie <- takeMVar waitMVar
	    putStrLn "cleanup thread awoken..."
	    l' <- swapMVar listMVar []
	    when (null l' && not shouldDie) (threadDelay 1000000)
            notdone <- filterM 
	                (\x -> do d <- songDone x
		 	          if d 
                                     then putStrLn "freeing song..." >>
freeSong x >> return False
			             else return True
		        ) 
	                (l ++ l')
	    unless (null notdone) (tryPutMVar waitMVar False >> return ())
	    if shouldDie 
                then return notdone
                else loop notdone

   in do putStrLn "starting cleanup loop"
         l <- loop []
         putStrLn "done with cleanup loop"
	 sequence_ (map (\x -> freeSong x >> putStrLn "freeing song late...")
l)
         putMVar killMVar ()

initLib :: IO LibState
initLib =
  do listMVar <- newMVar []
     waitMVar <- newEmptyMVar
     killMVar <- newEmptyMVar
     putStrLn "starting cleanup thread"
     forkIO (cleanupThread listMVar waitMVar killMVar)
     let libstate = LibState 
		    { listMV = listMVar
		    , waitMV = waitMVar 
		    , killMV = killMVar
		    }
     return libstate

shutdownLib :: LibState -> IO ()
shutdownLib libstate =
  do putMVar  (waitMV libstate) True
     takeMVar (killMV libstate)


main = 
 do 
    libstate <- initLib

    putStrLn "doing stuff"
    s <- mkSong libstate "my crazy song"
    let x = last $ takeWhile (< 10000000) $ iterate (+1) 1
    putStrLn (show x)
    putStrLn "done with stuff" 

    shutdownLib libstate

    putStrLn "bye"