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

[Bas van Dijk]

On 10 December 2012 14:12, Simon Marlow <marlowsd at gmail.com> wrote:
> 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
>

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