On Mon, Nov 21, 2005 at 10:41:38PM +0000, Joel Reymont wrote:
> STM would complicate things too much for me. At least I think so. I
> would love to use STM but I would need to fit it into "type
> ScriptState = ErrorT String (StateT World IO)" just to use the
> logger. I'm not THAT comfortable with monads.
I am talking about Software Transactional Memory, which is in
Control.Concurrent.STM. I think you confused it with State
Transformer Monad.
In your case STM would allow you to wait simultaneously on (T)MVar and
(T)Chan. It would look like this:
logger :: TMVar () -> IO ()
logger die =
join $ atomically $
(do x <- readTChan parent
return $ do
putStrLn x
logger die)
`orElse`
(do takeTMVar die
return (return ()))
but you have to modify the rest of code to use STM. I modified your
Conc.hs to use STM, but using the greater guarantees of STM you
could surely simplify it further (see the attached patch).
> Let me see if I understand you correctly... Are you saying that I
> should be using getChanContents in the code below?
I am not proposing to use getChanContents. You are busy-waiting
on MVar and Chan. I just proposed a solution to stuff messages
and die-request into the same concurrency primitive, so you
can wait for both events using a single operation.
But you are right (below) that this bug doesn't explain the behaviour of
your program. It is "only" a performance bug.
> logger :: Handle -> MVar () -> IO ()
> logger h die =
> do empty <- isEmptyChan parent
> unless empty $ do x <- readChan parent
> putStrLn x
> hPutStrLn h x
> alive <- isEmptyMVar die
> when (alive || not empty) $ logger h die
> I think using Maybe is a great trick but I'm curious why so few
> messages actually get taken out of the channel in the code above?
Actually, I am not sure. I just noticed that your code uses a bad
coding practice and could be improved. If I find some time I'll try to
examine it more closely.
> Are you saing that with all the checking it does not get to pull
> messages out?
As it is, you code can impose a big performance penalty, but indeed
it shouldn't change the semantics. Perhaps I miss something.
> I see clearly how using Maybe with getChanContents will work out
> perfectly. I don't understand why the above code is inefficient to
> the point of printing just a few messages (out of hundreds) out on
> Windows. I would like to understand it to avoid such mistakes in the
> future.
Yes, this is strange. Perhaps we're both missing something obvious.
Best regards
Tomasz
New patches:
[Use STM in Conc.hs
Tomasz Zielonka <[EMAIL PROTECTED]>**20051122065752] {
hunk ./Conc.hs 6
+import Control.Concurrent.STM
hunk ./Conc.hs 15
-children = unsafePerformIO $ newMVar []
+children = unsafePerformIO $ atomically $ newMVar []
hunk ./Conc.hs 20
-parent = unsafePerformIO newChan
+parent = unsafePerformIO $ atomically newChan
hunk ./Conc.hs 28
- writeChan parent $ stamp ++ ": " ++ (show tid) ++ ": " ++ a
+ atomically $ writeChan parent $ stamp ++ ": " ++ (show tid) ++ ": " ++ a
hunk ./Conc.hs 46
- do empty <- isEmptyChan parent
- unless empty $ do x <- readChan parent
- putStrLn x
- alive <- isEmptyMVar die
- when (alive || not empty) $ logger die
+ join $ atomically $
+ (do x <- readChan parent
+ return $ do
+ putStrLn x
+ logger die)
+ `orElse`
+ (do takeMVar die
+ return (return ()))
hunk ./Conc.hs 58
- logDie <- newEmptyMVar
- logDead <- newEmptyMVar
- l <- forkIO (logger logDie `finally` putMVar logDead ())
+ logDie <- atomically newEmptyMVar
+ logDead <- atomically newEmptyMVar
+ l <- forkIO (logger logDie `finally` atomically (putMVar logDead ()))
hunk ./Conc.hs 63
- do cs <- takeMVar children
+ do cs <- atomically (takeMVar children)
hunk ./Conc.hs 65
- [] -> do putMVar die ()
- takeMVar dead
+ [] -> do atomically $ do
+ putMVar die ()
+ takeMVar dead
hunk ./Conc.hs 69
- m:ms -> do putMVar children ms
- takeMVar m
+ m:ms -> do atomically $ do
+ putMVar children ms
+ takeMVar m
hunk ./Conc.hs 76
- do mvar <- newEmptyMVar
- childs <- takeMVar children
- putMVar children (mvar:childs)
- forkIO (io `finally` putMVar mvar ())
+ do mvar <- atomically newEmptyMVar
+ atomically $ do
+ childs <- takeMVar children
+ putMVar children (mvar:childs)
+ forkIO (io `finally` atomically (putMVar mvar ()))
hunk ./Conc.hs 84
+
replace ./Conc.hs [A-Za-z_0-9] Chan TChan
replace ./Conc.hs [A-Za-z_0-9] MVar TMVar
replace ./Conc.hs [A-Za-z_0-9] newChan newTChan
replace ./Conc.hs [A-Za-z_0-9] newEmptyMVar newEmptyTMVar
replace ./Conc.hs [A-Za-z_0-9] newMVar newTMVar
replace ./Conc.hs [A-Za-z_0-9] putMVar putTMVar
replace ./Conc.hs [A-Za-z_0-9] readChan readTChan
replace ./Conc.hs [A-Za-z_0-9] takeMVar takeTMVar
replace ./Conc.hs [A-Za-z_0-9] writeChan writeTChan
}
Context:
[free ssl handle, read chan 1 item/time, trace excepts
[EMAIL PROTECTED]
[added crash dumps to readme
[EMAIL PROTECTED]
[readme update
[EMAIL PROTECTED]
[server.pem
[EMAIL PROTECTED]
[updated readme
[EMAIL PROTECTED]
[really small readme
[EMAIL PROTECTED]
[launch 5000 clients, ulimit -n is your friend!
[EMAIL PROTECTED]
[small comment
[EMAIL PROTECTED]
[fully working
[EMAIL PROTECTED]
[ssl handshake working, client blocking indefinitely
[EMAIL PROTECTED]
[base
[EMAIL PROTECTED]
Patch bundle hash:
663bcce41b9368ca66e8f674d7c8e6f4df3c3892
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
