Haskell 如何在TVar上添加终结器

背景

作为对a的回应，我构建了一个和（不适合我上传）。如果名称不够，则有界tchan（BTChan）是具有最大容量的STM通道（如果通道有容量，则写入块）

最近，我收到一个添加dup功能的请求，如中的。问题就这样开始了

BTChan的外观如何

下面是BTChan的简化（实际上是非功能）视图

data BTChan a = BTChan
    { max :: Int
    , count :: TVar Int
    , channel :: TVar [(Int, a)]
    , nrDups  :: TVar Int
    }

每次写入通道时，都会在元组中包含DUP的数量（

nRDUP

）-这是一个“单个元素计数器”，指示有多少读卡器已获取此元素

每个读卡器都会减少它读取的元素的计数器，然后将它的读取指针移动到列表中的下一个元素。如果读卡器将计数器减至零，则

count

的值将减小，以正确反映通道上的可用容量

明确所需语义：通道容量表示通道中排队的最大元素数。任何给定元素都将排队，直到每个dup的读取器接收到该元素。对于GCed dup，任何元素都不应保持排队状态（这是主要问题）

例如，假设一个通道有三个DUP（c1、c2、c3），容量为2，其中2个项目写入通道，然后从

c1

和

c2

读取所有项目。通道仍然满（剩余容量为0），因为

c3

尚未消耗其副本。在任何时间点，如果对

c3

的所有引用都被删除（因此

c3

是GCD），则应释放容量（在这种情况下恢复为2）

问题是：假设我有以下代码

c <- newBTChan 1
_ <- dupBTChan c  -- This represents what would probably be a pathological bug or terminated reader
writeBTChan c "hello"
_ <- readBTChan c

请注意，

“hello”

的读取计数在末尾仍然是

1

？这意味着消息不会被视为消失（即使它在实际实现中会得到GCed），并且我们的

计数将永远不会减少。由于通道处于容量（最多1个元素），写入程序将始终阻塞

我希望在每次调用
dupBTChan
时创建一个终结器。当收集复制（或原始）通道时，该通道上剩余的所有要读取的元素将减少每个元素的计数，
nrDups
变量也将减少。因此，未来的写入将具有正确的
计数
（不为GCed通道未读取的变量保留空间的
计数
）

解决方案1-手动资源管理（我想要避免的）

出于这个原因，JNB的bounded tchan实际上有手动资源管理。请参阅
cancelBTChan
。我要做的是让用户更难出错的事情（并不是说手动管理在很多情况下都不是正确的方式）

解决方案2-通过在TVAR上阻塞来使用异常（GHC无法按照我的意愿执行此操作）

编辑此解决方案，而解决方案3只是一个衍生产品，不起作用！由于（WONTFIX）的原因，GHC编译器向两个阻塞线程发送异常，即使其中一个线程已经足够（理论上可以确定，但在GHC GC中不实用）

如果获取
BTChan
的所有方法都是IO，那么我们可以
forkIO
一个线程，该线程读取/重试给定
BTChan
所特有的额外（虚拟）TVar字段。当删除对TVar的所有其他引用时，新线程将捕获异常，因此它将知道何时减少
nrDups
和单个元素计数器。这应该会起作用，但会强制我的所有用户使用IO获取他们的
BTChan
s:

data BTChan = BTChan { ... as before ..., dummyTV :: TVar () }

dupBTChan :: BTChan a -> IO (BTChan a)
dupBTChan c = do
       ... as before ...
       d <- newTVarIO ()
       let chan = BTChan ... d
       forkIO $ watchChan chan
       return chan

watchBTChan :: BTChan a -> IO ()
watchBTChan b = do
    catch (atomically (readTVar (dummyTV b) >> retry)) $ \e -> do
    case fromException e of
        BlockedIndefinitelyOnSTM -> atomically $ do -- the BTChan must have gotten collected
            ls <- readTVar (channel b)
            writeTVar (channel b) (map (\(a,b) -> (a-1,b)) ls)
            readTVar (nrDup b) >>= writeTVar (nrDup b) . (-1)
        _ -> watchBTChan b

data BTChan=BTChan{…和以前一样…，dummyTV:：TVar（）}
dupBTChan:：BTChan a->IO（BTChan a）
dupBTChan c=do
... 和以前一样。。。
d IO（）
watchBTChan b=do
捕获（原子方式（readTVar（dummyTV b）>>重试））$\e->do
例外情况e
BlockedDefiniteLyonSTM->atomically$do——BTChan必须已收集
ls（a-1，b））ls）
readTVar（nrDup b）>>=writeTVar（nrDup b）。(-1)
_->watchBTChan b

编辑：是的，这是一个穷人的终结器，我没有任何特别的理由避免使用
addFinalizer
。这将是相同的解决方案，仍然强制使用IO afaict

解决方案3：比解决方案2更干净的API，但GHC仍然不支持它

用户通过调用
initBTChanCollector
启动manager线程，该线程将监视一组虚拟TVAR（来自解决方案2），并执行所需的清理。基本上，它将IO推入另一个线程，该线程知道如何通过全局（
unsafePerformIO
ed）
TVar
执行。工作原理基本上类似于解决方案2，但BTChan的创建仍然可以是STM。未能运行
initBTChanCollector
将导致进程运行时任务列表不断增加（空间泄漏）

解决方案4：绝不允许丢弃
BTChan
s

这类似于忽视问题。如果用户从未丢弃重复的
BTChan
，则问题消失

解决方案5
我看到了ezyang的答案（完全正确，值得赞赏），但我真的希望保留当前的API，只使用一个“dup”函数

**解决方案6**
请告诉我有更好的选择

编辑：
I（完全未经测试的alpha版本），并通过使全局本身成为
BTChan
，处理了潜在的空间泄漏-chan应该具有1的容量，因此忘记运行
init
显示得非常快，但这是一个小的变化。这在GHCi（7.0.3）中有效，但这似乎是偶然的。GHC向两个被阻止的线程（读取BTChan和监视线程的有效线程）抛出异常，因此my if you blocked r
data BTChan = BTChan { ... as before ..., dummyTV :: TVar () }

dupBTChan :: BTChan a -> IO (BTChan a)
dupBTChan c = do
       ... as before ...
       d <- newTVarIO ()
       let chan = BTChan ... d
       forkIO $ watchChan chan
       return chan

watchBTChan :: BTChan a -> IO ()
watchBTChan b = do
    catch (atomically (readTVar (dummyTV b) >> retry)) $ \e -> do
    case fromException e of
        BlockedIndefinitelyOnSTM -> atomically $ do -- the BTChan must have gotten collected
            ls <- readTVar (channel b)
            writeTVar (channel b) (map (\(a,b) -> (a-1,b)) ls)
            readTVar (nrDup b) >>= writeTVar (nrDup b) . (-1)
        _ -> watchBTChan b