我怎样才能通过延续来实现这个单子变压器

Question

动机。我正在尝试创建一个monad变压器，带有一个特殊的指令f <||> g这意味着"重复包含f <||> g的整个块，一次用f，下一次用g"。这是用于DSL转换的，尽管你可以想象其他应用程序。

示例用法。computation monad 表示不同的可能选择(在这种情况下，是要打印的东西(。printme函数说明如何处理每个不同的结果。在这种情况下，我们在运行之前打印"开始计算"，在运行之后打印"---"。

computation = do
    lift (print "start -- always")
    (lift (print "first choice") <||> lift (print "second choice"))
    lift (print "intermediate -- always")
    (lift (print "third choice") <||> lift (print "fourth choice"))
    lift (print "end -- always")
printme x = do
    putStrLn "=== start computation"
    xv <- x
    putStrLn "---n"
    return xv
test = runIndep printme computation

输出如下：

=== start computation
"start -- always"
"first choice"
"intermediate -- always"
"third choice"
"end -- always"
---
=== start computation
"start -- always"
"first choice"
"intermediate -- always"
"fourth choice"
"end -- always"
---
=== start computation
"start -- always"
"second choice"
"intermediate -- always"
"third choice"
"end -- always"
---
=== start computation
"start -- always"
"second choice"
"intermediate -- always"
"fourth choice"
"end -- always"
---

问题。有没有一种干净的方法可以使用某种延续传递样式的单元变压器来实现上述行为？我看过Oleg等人的"回溯，交错和终止Monad Transformers"论文，但似乎无法完全掌握它们的实现(一旦他们进入了带有延续的msplit实现(。

当前实施。我目前的实现是传入要做出的分支决策列表。monad 将返回它实际选择的分支列表，然后下次我们将切换最后一个可能的分支。代码如下(应该在 7.0.3 中运行(，

import Control.Monad.Trans.Class
data IndepModelT 𝔪 α = IndepModelT {
    unIndepModelT :: [Bool] -> 𝔪 (α, [Bool]) }
instance Monad 𝔪 => Monad (IndepModelT 𝔪) where
    return x = IndepModelT $ choices -> return (x, [])
    (IndepModelT x) >>= f = IndepModelT $ choices -> do
        (xv, branches) <- x choices
        let choices' = drop (length branches) choices
        (fxv, branches') <- unIndepModelT (f xv) choices'
        return (fxv, branches ++ branches')
instance MonadTrans IndepModelT where
    lift x = IndepModelT $ c -> liftWithChoice [] x
liftWithChoice cs mx = mx >>= xv -> return (xv, cs)
(<||>)
  :: Monad 𝔪 => IndepModelT 𝔪 α -> IndepModelT 𝔪 α -> IndepModelT 𝔪 α
(IndepModelT f) <||> (IndepModelT g) = IndepModelT go where
    go (False:cs) = do
        (fv, branches) <- f cs
        return (fv, False : branches)
    go (True:cs) = do
        (fv, branches) <- g cs
        return (fv, True : branches)
run_inner next_choices k comp@(IndepModelT comp_inner) = do
    (xv, branches) <- k $ comp_inner next_choices
    case (get_next_choices branches) of
        Nothing -> return ()
        Just choices -> run_inner (choices ++ repeat False) k comp
    where
        get_next_choices [] = Nothing
        get_next_choices [True] = Nothing
        get_next_choices [False] = Just [True]
        get_next_choices (c:cs)
            | Just cs' <- get_next_choices cs = Just $ c:cs'
            | c Prelude.== False = Just [True]
            | otherwise = Nothing
runIndep :: Monad 𝔪 =>
    (𝔪 (α, [Bool]) -> 𝔪 (β, [Bool]))
    -> IndepModelT 𝔪 α
    -> 𝔪 ()
runIndep = run_inner (repeat False)
runIndepFirst (IndepModelT comp) = comp (repeat False)

Answer 1

问题是：这不是一个monad！该行为甚至没有明确定义。F.e. 在这种情况下它应该怎么做：

do
  b <- ...randomly True or False...
  if b then ...some choices... else ...some other choices...

但是，它Applicative.我们需要的类型是 [IO a] ，它是 2 个应用函子的组合，因此我们可以使用变压器包中的Data.Functor.Compose。这也免费提供了一个Alternative实例，其中包含<|>。我们将使用可重新绑定语法来使用应用程序的 do 表示法：

{-# LANGUAGE RebindableSyntax #-}
import Prelude hiding ((>>), (>>=))
import Control.Applicative
import Data.Functor.Compose
lift :: Applicative f => g a -> Compose f g a
lift = Compose . pure
(>>) :: Applicative f => f a -> f b -> f b
(>>) = (*>)
computation :: Alternative f => Compose f IO ()
computation = do
    lift (print "start -- always")
    lift (print "first choice") <|> lift (print "second choice")
    lift (print "intermediate -- always")
    lift (print "third choice") <|> lift (print "fourth choice")
    lift (print "end -- always")
printme x = do
    putStrLn "=== start computation"
    x
    putStrLn "---n"
test = mapM printme $ getCompose computation

Answer 2

到目前为止，

您得到的建议不起作用。这是怎么回事：

f <||> g = ContT $ k -> do
  xs <- runContT f k
  ys <- runContT g k
  return $ xs ++ ys
test = runContT computation (return . (:[]))

但这不会重新启动每个选择的整个计算，结果是这样的：

"start -- always"
"first choice"
"intermediate -- always"
"third choice"
"end -- always"
"fourth choice"
"end -- always"
"second choice"
"intermediate -- always"
"third choice"
"end -- always"
"fourth choice"
"end -- always"

我还没有找到一个好的解决方案。

Answer 3

如果您专门寻找一种基于延续的方法，那么您不会比LogicT论文中SFKT成功/失败的延续实现简单得多。

如果msplit太多(而且它是一个非常微妙的野兽(，你可以忽略它在这个应用程序中。其目的是允许公平的连合和析取，如果这些示例输出行是按顺序打印的，则这不是规范的一部分。只需关注第 5.1 节中的Monad和MonadPlus实现，即可完成所有设置。

更新：正如Sjoerd Visscher指出的那样，这是不正确的，因为重新启动仅从mplus而不是整个计算中发生。这是一个比第一次阅读时更棘手的问题。