Hello,
I use addFinalizer from System.Mem.Weak for performing some actions on
data just before that is reclaimed by GC. Registered in this way
finalizer is called surprisingly early for me, much earlier the data is
tend to be collected.
I've attached source code of simple two-threaded program. Source code
also can be found at [1]. It is pretty simple and should be readable
enough.
Program is intentioned to pass messages through transactional variable
(TVar) for printing by worker thread. Messages consist of formatted to
String Int values from 1 to 1000000. So the output should look like
this:
> 1
> 2
> ...
> 1000000
But running the program gives something like that:
> 1
> 2
> ...
> 283
> finalizing
> Test: thread blocked indefinitely in an STM transaction
As far as I see, finalizer is called too early. If someone could point
me out how to do the right thing, that would be helpful.
Operaton system: Debian Squeeze
Compiler: GHC 6.12.1
Compiling options: none, just "ghc --make Test.hs"
Thanks,
balodja
[1] http://hpaste.org/44648
-- Simple example of message passing through TVar from base thread
-- to worker. Worker thread waits for messages on TVar and prints them out,
-- while base thread sends messages with 10ms delay.
module Main where
import System.Mem.Weak (addFinalizer)
import Control.Concurrent (ThreadId, forkIO, threadDelay, killThread)
import Control.Concurrent.STM (TVar, newTVarIO, readTVar, writeTVar, atomically, retry)
import Control.Monad (when, forever, forM_)
-- Data type for holding transaction variable and information about worker thread
data Socket = Socket ThreadId (TVar String)
-- "Open socket" means:
-- * create TVar for interaction between base and worker threads
-- * launch worker thread
-- * set finalizer on socket, that kills worker thread when the socket
-- is garbage collected
open :: IO Socket
open = do
var <- newTVarIO ""
threadId <- forkIO (loop var) -- launch worker thread
let sock = Socket threadId var
addFinalizer sock $ do
putStrLn "finalizing"
killThread threadId
return sock
where
loop var = forever $ do
x <- atomically $ extract var -- wait on TVar, read it
putStrLn x -- then print it, then repeat
extract var = do
x <- readTVar var
when (x == "") retry -- when no pending message, just wait
writeTVar var ""
return x
-- Send message. When there is already any message for delivery,
-- just wait and retry.
send :: Socket -> String -> IO ()
send sock@(Socket _ var) msg = do
atomically $ do
x <- readTVar var
when (x /= "") retry
writeTVar var msg
main :: IO ()
main = do
socket <- open
forM_ [1..1000000] $ \x -> do
send socket (show x)
threadDelay (10*1000)
_______________________________________________
Haskell-Cafe mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/haskell-cafe
