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