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

Question

мотивация .Я пытаюсь создать монадный преобразователь со специальной инструкцией 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"
---

вопрос.Есть ли чистый способ достижения вышеуказанного поведения, используя какой-то монадный преобразователь в стиле продолжения?Я посмотрел на статью Олега и др. «Обратное отслеживание, чередование и завершение монадных трансформаторов», но не могу полностью понять их реализацию (как только они дойдут до реализации 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 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

Вот проблема: это не монада! Поведение даже не четко определено. F.E. что он должен делать в этом случае:

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

Однако, это Applicative. Тип, который нам нужен, это [IO a], который состоит из двух аппликативных функторов, поэтому мы можем использовать Data.Functor.Compose из пакета трансформаторов. Это также дает Alternative экземпляр с <|> бесплатно. Мы будем использовать Rebindable Syntax, чтобы использовать нотацию 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

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

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

Обновление : как отмечает Шоэрд Висшер, это не так, какперезапуск происходит только с mplus, а не всего вычисления.Это гораздо более сложная проблема, чем кажется при первом прочтении.