СТМ и атомарно: почему семантика этих двух программ отличается?

Question

Давайте рассмотрим эту простую программу на Haskell:

module Main where

import Control.Concurrent.STM
import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Maybe
import Data.Monoid
import Control.Applicative


terminator :: Either SomeException () -> IO ()
terminator r = print $ "Dying with " <> show r

doStuff :: TMVar () -> TChan () -> Int -> IO ()
doStuff writeToken barrier w = void $ flip forkFinally terminator $ do
  hasWriteToken <- isJust <$> atomically (tryTakeTMVar writeToken)
  case hasWriteToken of
    True -> do
      print $ show w <> "I'm the lead.."
      threadDelay (5 * 10^6)
      print "Done heavy work"
      atomically $ writeTChan barrier ()
    False -> do
      print $ show w <> " I'm the worker, waiting for the barrier..."
      myChan <- atomically $ dupTChan barrier
      _ <- atomically $ readTChan myChan
      print "Unlocked!"



main :: IO ()
main = do
  writeToken <- newTMVarIO ()
  barrier <- newBroadcastTChanIO
  _ <- forM [1..20] (doStuff writeToken barrier)
  threadDelay (20 * 10^6)
  return ()

По сути, он моделирует сценарий параллелизма, в котором "лидер" получает токен записи, что-то делает, и рабочие синхронизируют барьер и путь "зеленого света" от лидера. Это работает, но если мы заменим рабочий "атомарный" блок следующим:

  _ <- atomically $ do
    myChan <- dupTChan barrier
    readTChan myChan

Все работники остаются заблокированными на неопределенный срок внутри транзакции STM:

"Done heavy work" 
"Dying with Right ()"
"Dying with Left thread blocked indefinitely in an STM transaction"
"Dying with Left thread blocked indefinitely in an STM transaction"
"Dying with Left thread blocked indefinitely in an STM transaction"
...

Я подозреваю, что ключ лежит внутри семантики atomically, Любая идея? Спасибо! Alfredo

Answer 1

Я думаю, что это поведение происходит от определения dupTChan, Скопировано здесь для удобства чтения вместе с readTChan

dupTChan :: TChan a -> STM (TChan a)
dupTChan (TChan _read write) = do
  hole <- readTVar write  
  new_read <- newTVar hole
  return (TChan new_read write)

readTChan :: TChan a -> STM a
readTChan (TChan read _write) = do
  listhead <- readTVar read
  head <- readTVar listhead
  case head of
    TNil -> retry
    TCons a tail -> do
    writeTVar read tail
    return a

вставляя эти функции, мы получаем этот блок STM:

worker_block (TChan _read write) = do
  hole <- readTVar write
  new_read <- newTVar hole
  listhead <- readTVar new_read
  head <- readTVar listhead
  case head of
    TNil -> retry
    ...

Когда вы пытаетесь запустить этот блок атомарно, мы создаем новый read_end из хвоста канала, затем вызываем readTVar в теме. Хвост, конечно, пуст, так что это readTVar повторится Однако, когда ведущий записывает в канал, акт записи в канал делает эту транзакцию недействительной! Таким образом, каждая последующая транзакция всегда будет повторяться.

На самом деле, я не думаю, что есть какой-либо случай, когда dupTChan >>= readTChan будет когда-либо приводить к чему-либо кроме потока, блокируемого на неопределенный срок в транзакции STM. Вы можете также объяснить это из документации. dupTChan начинается пустым, поэтому в рамках одной атомарной транзакции у нее никогда не будет никаких элементов, если только та же транзакция не добавит их.