Jak mogę wdrożyć ten transformator monad z kontynuacją?

Question

motywacja. Próbuję utworzyć transformator Monada ze specjalną instrukcją f <||> g, która oznacza "powtórz cały blok zawierający f <||> g, raz z f, następnym razem z g". Ma to na celu transformację DSL, choć można sobie wyobrazić inne aplikacje.

przykład użycia. Monada computation wyraża różne możliwe wybory (w tym przypadku rzeczy do wydrukowania). Funkcja printme mówi, co zrobić z każdym innym wynikiem. W tym przypadku drukujemy "obliczenia początkowe" przed uruchomieniem i "---" po.

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 

wyjście jest następująca,

=== 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" 
--- 

pytanie. Czy istnieje czysty sposób na osiągnięcie powyższego zachowania za pomocą pewnego rodzaju transformatora monad kontynuującego styl? Przyjrzałem się artykułowi "Backtracking, Interleaving, and Terminating Monad Transformers" Olega i innych, ale nie można w pełni pojąć ich implementacji (gdy dojdą do implementacji msplit z kontynuacjami).

obecna realizacja. Moja obecna implementacja jest przekazywana na listę decyzji, które należy rozgrupować. Monada zwróci listę gałęzi, które faktycznie wybiera, a następnie następnym razem zmienimy ostatnią gałąź. Kod jest następujący (powinien działać w 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

Oto problem: to nie jest monada! Zachowanie nie jest nawet dobrze zdefiniowane. F.e. Co należy zrobić w takiej sytuacji:

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

Jednak jest Applicative.Typ jakiego potrzebujemy to [IO a], który jest składem 2 funktetów aplikacyjnych, dzięki czemu możemy użyć Data.Functor.Compose z pakietu transformatorów. To daje również instancję Alternative z <|> również za darmo. Użyjemy Rebindable Składnia użyć do-notację dla 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 

Answer 2

Jeśli szukasz specjalnie dla kontynuacji podejścia opartego nie zamierzamy uzyskać znacznie prostsze niż SFKT sukcesu/awarii kontynuacji wdrożenie w the LogicT paper.

Jeśli msplit jest za dużo (i jest to dość subtelna bestia), możesz po prostu zignorować to dla tej aplikacji. Jego celem jest umożliwienie uczciwej koniunkcji i rozłączności, która nie jest częścią twojej specyfikacji, jeśli linie wyjściowe próbki mają być drukowane w kolejności. Skoncentruj się na implementacjach Monad i MonadPlus w sekcji 5.1, a wszystko będzie gotowe.

Aktualizacja: Jak Sjoerd Visscher zwraca uwagę, to nie jest w porządku, jak tylko ponowne uruchomienie dzieje z mplus zamiast całej obliczeń. Jest to znacznie trudniejszy problem, niż się wydaje na pierwszy rzut oka.

Answer 3

Sugestia, którą otrzymałeś do tej pory, nie działa. Oto jak to pójdzie:

f <||> g = ContT $ \k -> do 
    xs <- runContT f k 
    ys <- runContT g k 
    return $ xs ++ ys 

test = runContT computation (return . (:[])) 

Ale to nie uruchamia cały obliczeń dla każdego wyboru, wynik jest taki:

"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" 

nie znalazłem jeszcze dobrym rozwiązaniem.