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

[Simon Marlow]

On 10/12/12 12:23, Bas van Dijk wrote:
> On 10 December 2012 12:51, Simon Marlow <marlowsd at gmail.com> wrote:
>> On 09/12/12 21:24, Bas van Dijk wrote:
>>>
>>> On 9 December 2012 21:52, Bas van Dijk <v.dijk.bas at gmail.com> wrote:
>>>>
>>>> On 9 December 2012 20:50, Bas van Dijk <v.dijk.bas at gmail.com> wrote:
>>>>>
>>>>> On 9 December 2012 16:48, Patrick Palka <patrick at parcs.ath.cx> 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 at 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/f184d9caffa09750ef6a374a7987b9213d6db28e

Cheers,
	Simon