Как я могу реализовать этот монадный трансформатор с продолжением?

мотивация. Я пытаюсь создать монадный трансформатор со специальной командой f <||> g, что означает "повторить весь этот блок, содержащий f <||> g, один раз с f, в следующий раз с g". Это предназначено для преобразования DSL, хотя вы можете представить себе другие приложения.

пример использования. Монада computation выражает различные возможные варианты (в данном случае, вещи для печати). Функция 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"
---

вопрос. Есть ли чистый способ достичь вышеуказанного поведения с помощью какого-то продолжения переходного монадного трансформатора? Я посмотрел на Олега и др. "Backtracking, Interleaving и Terminating Monad Transformers", но, похоже, не могут полностью понять их реализацию (как только они дойдут до реализации msplit с продолжением).

текущая реализация. Моя текущая реализация состоит в том, чтобы передать список решений для ветвления. Монада вернет список ветвей, которые он на самом деле выбирает, а затем в следующий раз мы переключим последнюю возможную ветвь. Код выглядит следующим образом (должен работать в 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 [email protected](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)

Ответ 1

Здесь проблема: это не монада! Поведение даже не определено. 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 с <|> бесплатно. Мы будем использовать Rebindable Syntax для использования do-notation для Applicatives:

{-# 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

Ответ 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"

Я еще не нашел хорошего решения.

Ответ 3

Если вы ищете конкретный подход, основанный на продолжении, вы не будете намного проще, чем реализация продолжения успеха/отказа SFKT в документ LogicT.

Если msplit слишком много (и это довольно тонкий зверь), вы можете просто игнорировать его для этого приложения. Его цель - обеспечить справедливое соединение и дизъюнкцию, которая не входит в вашу спецификацию, если эти строки вывода проб предназначены для печати по порядку. Просто сосредоточьтесь на реализациях Monad и MonadPlus в разделе 5.1, и все будет установлено.

Обновить. Как указывает Sjoerd Visscher, это неверно, поскольку перезапуск происходит только из mplus, а не всего вычисления. Это гораздо более сложная проблема, чем кажется на первый взгляд.