Re: [stm] strange behavior with TQueue and STM's alternative instance

10 Dec 2012


      On 10 December 2012 14:12, Simon Marlow  wrote:
...
On 10/12/12 12:23, Bas van Dijk wrote:
...
On 10 December 2012 12:51, Simon Marlow  wrote:
...
On 09/12/12 21:24, Bas van Dijk wrote:
...
On 9 December 2012 21:52, Bas van Dijk  wrote:
...
On 9 December 2012 20:50, Bas van Dijk  wrote:
...
On 9 December 2012 16:48, Patrick Palka  wrote:
>
>
> Hi,
>
> I'm getting strange behavior when using the 'many' combinator to read
> zero
> or more items off of a TQueue with readTQueue. The script that
> exhibits
> this
> behavior is as follows:
>
> import Control.Concurrent.STM
> import Control.Concurrent
> import Control.Monad
> import Control.Applicative
>
> main = do
>       q <- newTQueueIO
>       atomically $ writeTQueue q True
>       atomically $ writeTQueue q False
>       forever $ do
>           xs <- atomically $ many $ readTQueue q
>           print xs
>           threadDelay 500000
>
>
> I'd expect the output of the script to be:
> [True,False]
> []
> []
> ...
>
> However, that is not the case: the actual output of the script is:
> [True,False]
> [True,False]
> [True,False]
> ...
>
> This means that TQueue is incompatible with TChan, since if TQueue is
> replaced by TChan then the script behaves as one would expect.
>
> If 1 element (say, True) is written into the TQueue instead of 2,
> then
> the
> output of the script is:
> [True]
> []
> []
> ...
>
> Which is expected behavior, but inconsistent with the behavior when
> the
> TQueue has 2 or more elements in it.
>
> Is this considered a bug, or undocumented behavior of TQueue?
>
> _______________________________________________
> Libraries mailing list
> Libraries@haskell.org
> http://www.haskell.org/mailman/listinfo/libraries
>
This is puzzling me. It looks like a bug in STM. The following code
should have the same behavior. Interestingly, when I remove the
'readTVar write' marked "Remove me!!!" I get the desired behavior:
import Control.Concurrent.STM
      (STM, atomically, retry, TVar, newTVarIO, readTVar, writeTVar)
import Control.Concurrent
import Control.Monad
import Control.Applicative
main = do
    q@(TQueue read write) <- newTQueueIO
    atomically $ writeTQueue q True
    atomically $ writeTQueue q False
    forever $ do
      xs <- atomically $
        (((:) <$> readTQueue q <*>
          (((:) <$> readTQueue q <*>
            (((:) <$> (do readTVar read
                          readTVar write -- Remove me!!!
                          retry
                      ) <*> error "..."
             ) <|> pure []
            )
           ) <|> pure []
          )
         ) <|> pure []
        )
      print xs
      threadDelay 500000
data TQueue a = TQueue {-# UNPACK #-} !(TVar [a])
                         {-# UNPACK #-} !(TVar [a])
newTQueueIO :: IO (TQueue a)
newTQueueIO = do
    read  <- newTVarIO []
    write <- newTVarIO []
    return (TQueue read write)
writeTQueue :: TQueue a -> a -> STM ()
writeTQueue (TQueue _read write) a = do
    listend <- readTVar write
    writeTVar write (a:listend)
readTQueue :: Show a => TQueue a -> STM a
readTQueue (TQueue read write) = do
    xs <- readTVar read
    case xs of
      (x:xs') -> do writeTVar read xs'
                    return x
      [] -> do ys <- readTVar write
               case ys of
                 [] -> retry
                 _  -> case reverse ys of
                         [] -> error "readTQueue"
                         (z:zs) -> do writeTVar write []
                                      writeTVar read zs
                                      return z
Bas
This is a simplified program which behaves in the same non-expected
way:
main = do
    t <- newTVarIO 1
    atomically $ do
      writeTVar t 2
      ((readTVar t >> retry) `orElse` return ()) `orElse` return ()
    atomically (readTVar t) >>= print
    threadDelay 500000
This program prints 1 while I expect it to print 2.
It prints 2 when I remove the outer `orElse`:
main = do
    t <- newTVarIO 1
    atomically $ do
      writeTVar t 2
      ((readTVar t >> retry) `orElse` return ())
    atomically (readTVar t) >>= print
    threadDelay 500000
It also prints 2 when I remove the readTVar:
main = do
    t <- newTVarIO 1
    atomically $ do
      writeTVar t 2
      (retry `orElse` return ()) `orElse` return ()
    atomically (readTVar t) >>= print
    threadDelay 500000
Bas
The simplest program I can come up with which shows the same behavior:
$ cat stmTest.hs
import Control.Concurrent.STM
main = do
    x <- atomically $ do
           t <- newTVar 1
           writeTVar t 2
           ((readTVar t >> retry) `orElse` return ()) `orElse` return ()
           readTVar t
    print x
$ ghc --make stmTest.hs -fforce-recomp -threaded -o stmTest && ./stmTest
[1 of 1] Compiling Main             ( stmTest.hs, stmTest.o )
Linking stmTest ...
1
Nice bug!  I have a fix, will try to get it into GHC 7.6.2.
Cheers,
         Simon
Great!
I would like to understand what went wrong. I looked at the retry and
catchRetry PrimOps but didn't understand them well enough to figure
out the bug. Do you have a link to your patch?
Sure:
http://hackage.haskell.org/trac/ghc/changeset/f184d9caffa09750ef6a374a7987b9...
Cheers,
        Simon
Thanks, does this also fix the case when the inner transaction writes
instead of reads? As in:

import Control.Concurrent.STM
main = do
  x <- atomically $ do
         t <- newTVar 1
         writeTVar t 2
         ((writeTVar t 3 >> retry) `orElse` return ()) `orElse` return ()
         readTVar t
  print x

Bas