¿cómo puedo implementar este transformador de mónada con una continuación?

Question

motivación. Estoy tratando de crear un transformador de mónada, con una instrucción especial f <||> g que significa "repetir todo este bloque que contiene f <||> g, una vez con f, la próxima vez con g". Esto debe ser para una transformación DSL, aunque puede imaginar otras aplicaciones.

ejemplo de uso. La mónada computation expresa diferentes opciones posibles (en este caso, de cosas para imprimir). La función printme dice qué hacer con cada resultado diferente. En este caso, imprimimos "iniciar computación" antes de que se ejecute, y "---" después.

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 

la salida es la siguiente,

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

cuestión. ¿Existe alguna forma clara de lograr el comportamiento anterior utilizando algún tipo de transformador de mónada de estilo de paso de continuación? He examinado el documento "Retroceso, intercalado y terminación de transformadores de mónadas de Oleg et al." De Oleg y otros, pero parece que no se comprende completamente su implementación (una vez que llegan a la implementación msplit con continuaciones).

implementación actual. Mi implementación actual es pasar una lista de decisiones de bifurcación a tomar. La mónada devolverá una lista de las ramas que realmente elige, y la próxima vez cambiaremos la última rama posible. El código es el siguiente (se debe ejecutar en 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

Aquí está el problema: ¡esto no es una mónada! El comportamiento ni siquiera está bien definido. F.e. lo que debe hacer en este caso:

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

Sin embargo, es Applicative.El tipo que necesitamos es [IO a], que es la composición de 2 funtores aplicativos, por lo que podemos usar Data.Functor.Compose del paquete de transformadores. Esto da una instancia Alternative con <|> gratis también. Vamos a utilizar Rebindable Sintaxis para utilizar el do-notación para aplicativos:

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

Si está buscando específicamente para un enfoque basado en la continuación, usted no va a conseguir mucho más simple que el SFKT éxito/fracaso continuidad implementación en the LogicT paper.

Si msplit es demasiado (y es una bestia bastante sutil), puede ignorarlo para esta aplicación. Su propósito es permitir la conjunción y la disyunción justas, que no forman parte de su especificación si esas líneas de salida de muestra están destinadas a imprimir en orden. Solo concéntrese en las implementaciones Monad y MonadPlus en la sección 5.1 y estará todo listo.

Actualización: Como señala Sjoerd Visscher, esto no es correcto, ya que el reinicio solo se produce en mplus en lugar de en el cálculo completo. Este es un problema mucho más complicado de lo que parece en la primera lectura.

Answer 3

La sugerencia que ha recibido hasta ahora no funciona. Así es como eso iría:

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

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

Pero eso no reiniciar todo el cálculo para cada elección, el resultado es este:

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

no he encontrado una buena solución todavía.