algorithm - traduccion - Control de flujo preciso en Haskell

monads scala

Question

La idea

¡Hola! Estoy tratando de implementar en Haskell una biblioteca de procesamiento de imágenes basada en la ideología del flujo de datos. Tengo un problema relacionado con la forma en que quiero manejar el flujo de control.

La idea principal es introducir un time . El time es un Float , al que se puede acceder desde cualquier parte del código (se puede pensar en Mónada State, pero un poco más divertido). Lo curioso de esto es que podemos usar la operación timeShift en los resultados, afectando el tiempo que las operaciones correspondientes verían.

Un ejemplo sería lo mejor para explicar esta situación. Permite usar el siguiente diagrama de flujo de datos:

--               timeShift(*2) --
--              /                 /
-- readImage --                    addImages -> out
--              /                 /
--                blur ----------

y su pseudocódigo (que no es typecheck - no es importante si usamos do o let notación aquí, la idea debería ser clara):

test = do
    f      <- frame
    a      <- readImage $ "test" + show f + ".jpg"
    aBlur  <- blur a
    a''     <- a.timeShift(*2)
    out    <- addImage aBlur a''

main = print =<< runStateT test 5

El 5 es el time que queremos ejecutar la función de test . La función timeShift afecta a todas las operaciones a la izquierda (en el diagrama de flujo de datos); en este caso, la función readImage se ejecutará dos veces para ambas ramas, la inferior usaría la trama 5 y la superior un cuadro 5*2 = 10 .

El problema

Proporciono aquí una implementación muy simple, que funciona muy bien, pero tiene algunas advertencias que quiero resolver. El problema es que quiero mantener el orden de todas las operaciones de IO. Mira la parte inferior, por ejemplo, lo que aclarará a qué me refiero.

Implementación de muestra

A continuación se muestra una implementación de ejemplo del algoritmo y un código, que construye el siguiente gráfico de flujo de datos:

-- A --- blur --- timeShift(*2) --
--                                /
--                                 addImages -> out
--                                /
-- B --- blur --------------------

el código:

import Control.Monad.State

-- for simplicity, lets assume an Image is just a String
type Image = String

imagesStr = ["a0","b1","c2","d3","e4","f5","g6","h7","i8","j9","k10","l11","m12","n13","o14","p15","q16","r17","s18","t19","u20","v21","w22","x23","y24","z25"]
images = "abcdefghjiklmnoprstuwxyz"

--------------------------------
-- Ordinary Image processing functions

blurImg'' :: Image -> Image
blurImg'' img = "(blur " ++ img ++ ")"

addImage'' :: Image -> Image -> Image
addImage'' img1 img2 = "(add " ++ img1 ++ " " ++ img2 ++ ")"

--------------------------------
-- Functions processing Images in States

readImage1 :: StateT Int IO Image
readImage1 = do
    t <- get
    liftIO . putStrLn $ "[1] reading image with time: " ++ show t
    return $ imagesStr !! t

readImage2 :: StateT Int IO Image
readImage2 = do
    t <- get
    liftIO . putStrLn $ "[2] reading image with time: " ++ show t
    return $ imagesStr !! t

blurImg :: StateT Int IO Image -> StateT Int IO Image
blurImg img = do
    i <- img
    liftIO $ putStrLn "blurring"
    return $ blurImg'' i

addImage :: StateT Int IO Image -> StateT Int IO Image -> StateT Int IO Image
addImage img1 img2 = do
    i1 <- img1
    i2 <- img2
    liftIO $ putStrLn "adding images"
    return $ addImage'' i1 i2


timeShift :: StateT Int IO Image -> (Int -> Int) -> StateT Int IO Image
timeShift img f = do
    t <- get
    put (f t)
    i <- img
    put t
    return i

test = out where
    i1   = readImage1
    j1   = readImage2

    i2   = blurImg i1
    j2   = blurImg j1

    i3   = timeShift i2 (*2)
    out  = addImage i3 j2


main = do
    print =<< runStateT test 5
    print "end"

El resultado es:

[1] reading image with time: 10
blurring
[2] reading image with time: 5
blurring
adding images
("(add (blur k10) (blur f5))",5)
"end"

y debería ser:

[1] reading image with time: 10
[2] reading image with time: 5
blurring
blurring
adding images
("(add (blur k10) (blur f5))",5)
"end"

Tenga en cuenta que la salida correcta es ("(add (blur k10) (blur f5))",5) - lo que significa que hemos agregado la imagen k10 a f5 - del fotograma 10º y 5º respectivamente.

Más requisitos Estoy buscando una solución que permita a los usuarios escribir código simple (como en la función de test , por supuesto podría estar en una Monad), pero no quiero que manejen la lógica de desplazamiento de tiempo a mano.

Conclusiones

La única diferencia es el orden de ejecución de las acciones de IO. Me encantaría preservar el orden de las acciones de IO tal como están escritas en la función de test . Estaba intentando implementar la idea usando Countinuations , Arrows y algunos estados divertidos, pero sin éxito.

Answer 1

Una Monad no puede reordenar los pasos del componente que componen img1 e img2 en

addImage :: (Monad m) => m [i] -> m [i] -> m [i]
addImage img1 img2 = do
    i1 <- img1
    i2 <- img2
    return $ i1 ++ i2

si existe alguna m [i] cuyo resultado dependa de un efecto secundario. Cualquier MonadIO m tiene un m [i] cuyo resultado depende de un efecto secundario, por lo tanto, no puede reordenar los pasos del componente de img1 e img2 .

Los azúcares anteriores a

addImage :: (Monad m) => m [i] -> m [i] -> m [i]
addImage img1 img2 =
    img1 >>=
        (/i1 ->
            img2 >>=
                (/i2 ->
                    return (i1 ++ i2)
                )
        )

Centrémonos en el primero >>= (recordando que (>>=) :: forall a b. ma -> (a -> mb) -> mb ). Especializado para nuestro tipo, esto es (>>=) :: m [i] -> ([i] -> m [i]) -> m [i] . Si vamos a implementarlo, tendríamos que escribir algo como

(img1 :: m [i]) >>= (f :: [i] -> m [i]) = ... 

Para hacer algo con f , necesitamos pasarlo por [i] . El único [i] correcto que tenemos está atrapado dentro de img1 :: m [i] . Necesitamos el resultado de img1 para hacer cualquier cosa con f . Ahora hay dos posibilidades. O bien podemos o no podemos determinar el resultado de img1 sin ejecutar sus efectos secundarios. Examinaremos ambos casos, comenzando con cuando no podamos.

no poder

Cuando no podemos determinar el resultado de img1 sin ejecutar sus efectos secundarios, solo tenemos una opción: debemos ejecutar img1 y todos sus efectos secundarios. Ahora tenemos un [i] , pero todos los efectos secundarios de img1 ya se han ejecutado. No hay manera de que podamos ejecutar ninguno de los efectos secundarios de img2 antes de algunos de los efectos secundarios de img1 porque los efectos secundarios de img1 ya han sucedido.

poder

Si podemos determinar el resultado de img1 sin ejecutar sus efectos secundarios, estamos de suerte. Hallamos el resultado de img1 y pasamos eso a f , obteniendo un nuevo m [i] contiene el resultado que queremos. Ahora podemos examinar los efectos secundarios de ambos img1 y el nuevo m [i] y reordenarlos (aunque aquí hay una gran advertencia sobre la ley asociativa para >>= ).

el problema a mano

Como esto se aplica a nuestro caso, para cualquier MonadIO , existe lo siguiente, cuyo resultado no puede determinarse sin ejecutar sus efectos secundarios, colocándonos firmemente en el caso imposible en el que no podamos reordenar los efectos secundarios.

counterExample :: (MonadIO m) => m String
counterExample = liftIO getLine

También hay muchos otros ejemplos de contador, como readImage1 o readImage2 que realmente deben leer la imagen de IO .

Answer 2

Las bibliotecas de Dataflow y de programación reactiva funcional en Haskell generalmente se escriben en términos de Applicative o Arrow . Estas son abstracciones para cálculos que son menos generales que los de Monad: las clases de tipos Aplicable y Arrow no exponen una manera para que la estructura de los cálculos dependa de los resultados de otros cálculos. Como resultado, las bibliotecas que exponen solo estas clases de tipos pueden razonar sobre la estructura de los cálculos en la biblioteca independientemente de realizar esos cálculos. Resolveremos su problema en términos de la clase de tipo Applicative

class Functor f => Applicative f where
    -- | Lift a value.
    pure :: a -> f a    
    -- | Sequential application.
    (<*>) :: f (a -> b) -> f a -> f b

Applicative permite a un usuario de la biblioteca realizar nuevos cálculos con pure , operar en cómputos existentes con fmap (de Functor ) y componer cálculos junto con <*> , usando el resultado de un cálculo como entrada para otro. No permite que un usuario de la biblioteca haga un cálculo que hace otro cálculo y luego usa el resultado de ese cálculo directamente; no hay forma de que un usuario pueda escribir join :: f (fa) -> fa . Esta restricción evitará que nuestra biblioteca se encuentre con el problema que describí en mi otra respuesta .

Transformadores, libres, y el transformador ApT

Tu problema de ejemplo es bastante complicado, por lo que vamos a sacar un montón de trucos Haskell de alto nivel y crear algunos nuevos. Los primeros dos trucos que vamos a sacar son transformadores y tipos de datos libres . Los transformadores son tipos que toman tipos con un tipo como el de Functor , Applicative o Monad y producen nuevos tipos del mismo tipo.

Los transformadores suelen tener el siguiente Double ejemplo. Double puede tomar cualquier Functor o Applicative o Monad y crear una versión que siempre contenga dos valores en lugar de uno

newtype Double f a = Double {runDouble :: f (a, a)}

Los tipos de datos libres son transformadores que hacen dos cosas. En primer lugar, dada alguna propiedad más simple del tipo subyacente, se obtienen nuevas propiedades interesantes para el tipo transformado. La Monad Free proporciona una Monad con cualquier Functor , y la Applicative gratuita, Ap , hace un Applicative de cualquier Functor . Lo otro que hacen los tipos "libres" es que "liberan" la implementación del intérprete tanto como sea posible . Aquí están los tipos para el FreeT gratuito, Ap , el Monad Free , Free , y el transfomer gratuito para mónadas, FreeT . El transformador de mónada gratuito proporciona un transformador de mónada para "libre" dado un Functor

-- Free Applicative
data Ap f a where
    Pure :: a -> Ap f a
    Ap   :: f a -> Ap f (a -> b) -> Ap f b

-- Base functor of the free monad transformer
data FreeF f a b
    = Pure a    
    | Free (f b)    

-- Free monad transformer
newtype FreeT f m a = FreeT {runFreeT :: m (FreeF f a (FreeT f m a)}

-- The free monad is the free monad transformer applied to the Identity monad
type Free f = FreeT f Identity

Aquí hay un boceto de nuestro objetivo: queremos proporcionar una interfaz Applicative para combinar cálculos, que, en la parte inferior, permita los cómputos de Monad ic. Queremos "liberar" al intérprete tanto como sea posible para que pueda reordenar los cálculos. Para hacer esto, combinaremos tanto el transformador de mónadas gratuito Applicative como el libre.

Queremos una interfaz Applicative , y la más fácil de hacer es la que podemos obtener para "gratis", que se alinea muy bien con nuestra meta de "liberar al interpetador" tanto como sea posible. Esto sugiere que nuestro tipo se verá como

Ap f a

para algunos Functor f y cualquier a . Nos gustaría que el cómputo subyacente sea sobre alguna Monad , y las Monad son funcionadoras, pero nos gustaría "liberar" al intérprete tanto como sea posible. Cogeremos el transformador de mónada gratuito como el functor subyacente para Ap , dándonos

Ap (FreeT f m) a

para algunos Functor f , algunos Monad m , y cualquier a . Sabemos que la Monad probablemente sea IO , pero dejaremos nuestro código lo más genérico posible. Solo tenemos que proporcionar el Functor para FreeT . Todos los Functors son Functors , por lo que Ap podría usarse para f , escribiríamos algo como

type ApT m a = Ap (FreeT (ApT m) m) a

Esto le da al compilador ajustes, así que en su lugar moveremos el Ap dentro y definiremos

newtype ApT m a = ApT {unApT :: FreeT (Ap (ApT m)) m a}

Obtendremos algunas instancias para esto y discutiremos su motivación real después de un interludio.

Interludio

Para ejecutar todo este código, necesitarás lo siguiente. El Map y el Control.Concurrent solo son necesarios para compartir cálculos, más sobre eso mucho más tarde.

{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Main where

import Control.Monad.Trans.Class
import Control.Monad.IO.Class

import Control.Monad.Trans.Reader
import Control.Applicative

import Control.Applicative.Free hiding (Pure)
import qualified Control.Applicative.Free as Ap (Ap(Pure))
import Control.Monad.Trans.Free

import qualified Data.Map as Map
import Control.Concurrent

Rellenándolo

Te engañé en la sección anterior y fingí descubrir que ApT no podía entender el problema. De hecho, descubrí ApT probando cualquier cosa para tratar de ApT de ApT en un Applicative y poder controlar su orden cuando salió. Durante mucho tiempo, estaba tratando de resolver cómo implementar mapApM (a continuación) para escribir flipImage (mi reemplazo para su blur ). Aquí está el transformador ApT en todo su esplendor. Está destinado a ser utilizado como el Functor para un Ap , y, al utilizar Ap como su propio Functor para FreeT , puede mágicamente introducir valores en un Applicative que no debería parecer posible.

newtype ApT m a = ApT {unApT :: FreeT (Ap (ApT m)) m a}
     deriving (Functor, Applicative, Monad, MonadIO)

Podría derivar aún más instancias de FreeT , estas son solo las que necesitamos. No puede derivar MonadTrans , pero podemos hacerlo nosotros mismos:

instance MonadTrans ApT where
    lift = ApT . lift

runApT :: ApT m a -> m (FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a))
runApT = runFreeT . unApT

La verdadera belleza de ApT es que podemos escribir algunos códigos aparentemente imposibles como

stuffM :: (Functor m, Monad m) => m (ApT m a) -> ApT m a
stuffMAp :: (Functor m, Monad m) => m (ApT m a) -> Ap (ApT m) a

El m en el exterior desaparece, incluso en Ap que es meramente Applicative .

Esto funciona debido al siguiente ciclo de funciones, cada una de las cuales puede rellenar la salida de la función que está arriba en la entrada de la función debajo de ella. La primera función comienza con una ApT ma , y la última termina con una. (Estas definiciones no son parte del programa)

liftAp'' :: ApT m a ->
           Ap (ApT m) a
liftAp'' = liftAp

fmapReturn :: (Monad m) =>
               Ap (ApT m) a ->
               Ap (ApT m) (FreeT (Ap (ApT m)) m a)
fmapReturn = fmap return

free'' :: Ap (ApT m) (FreeT (Ap (ApT m)) m a) ->
         FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a)
free'' = Free

pure'' :: a ->
         FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a)
pure'' = Pure

return'' :: (Monad m) =>
           FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a) ->
           m (FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a))
return'' = return

freeT :: m (FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a)) ->
         FreeT (Ap (ApT m)) m a
freeT = FreeT

apT :: FreeT (Ap (ApT m)) m a ->
       ApT m a
apT = ApT

Esto nos permite escribir

-- Get rid of an Ap by stuffing it into an ApT.
stuffAp :: (Monad m) => Ap (ApT m) a -> ApT m a
stuffAp = ApT . FreeT . return . Free . fmap return

-- Stuff ApT into Free
stuffApTFree :: (Monad m) => ApT m a -> FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a)
stuffApTFree = Free . fmap return . liftAp

-- Get rid of an m by stuffing it into an ApT
stuffM :: (Functor m, Monad m) => m (ApT m a) -> ApT m a
stuffM = ApT . FreeT . fmap stuffApTFree

-- Get rid of an m by stuffing it into an Ap
stuffMAp :: (Functor m, Monad m) => m (ApT m a) -> Ap (ApT m) a
stuffMAp = liftAp . stuffM

Y algunas funciones de utilidad para trabajar en una pila de transformadores

mapFreeT :: (Functor f, Functor m, Monad m) => (m a -> m b) -> FreeT f m a -> FreeT f m b
mapFreeT f fa = do
    a <- fa
    FreeT . fmap Pure . f . return $ a

mapApT :: (Functor m, Monad m) => (m a -> m b) -> ApT m a -> ApT m b
mapApT f = ApT . mapFreeT f . unApT

mapApM :: (Functor m, Monad m) => (m a -> m b) -> Ap (ApT m) a -> Ap (ApT m) b
mapApM f = liftAp . mapApT f . stuffAp

Nos gustaría comenzar a escribir nuestros procesadores de imagen de ejemplo, pero primero tenemos que tomar otra diversión para abordar un requisito difícil.

Un requisito difícil: compartir entradas

Tu primer ejemplo muestra

--               timeShift(*2) --
--              /                 /
-- readImage --                    addImages -> out
--              /                 /
--                blur ----------

lo que implica que el resultado de readImage debe compartir entre blur y timeShift(*2) . Considero que esto significa que los resultados de readImage solo se deben calcular una vez para cada momento.

Applicative no es lo suficientemente poderoso como para capturar esto. Crearemos una nueva clase de tipos para representar cómputos cuyo resultado se puede dividir en múltiples flujos idénticos.

-- The class of things where input can be shared and divided among multiple parts
class Applicative f => Divisible f where
    (</>) :: (f a -> f b) -> f a -> f b

Vamos a hacer un transformador que agregue esta capacidad a las Applicative existentes.

-- A transformer that adds input sharing
data LetT f a where
    NoLet :: f a -> LetT f a
    Let   :: LetT f b -> (LetT f b -> LetT f a) -> LetT f a

Y proporcione algunas funciones de utilidad e instancias para ello

-- A transformer that adds input sharing
data LetT f a where
    NoLet :: f a -> LetT f a
    Let   :: LetT f b -> (LetT f b -> LetT f a) -> LetT f a

liftLetT :: f a -> LetT f a
liftLetT = NoLet

mapLetT :: (f a -> f b) -> LetT f a -> LetT f b
mapLetT f = go
    where
        go (NoLet a) = NoLet (f a)
        go (Let b g) = Let b (go . g)

instance (Applicative f) => Functor (LetT f) where
    fmap f = mapLetT (fmap f)

-- I haven''t checked that these obey the Applicative laws.
instance (Applicative f) => Applicative (LetT f) where
    pure = NoLet . pure
    NoLet f <*> a = mapLetT (f <*>) a
    Let c h <*> a = Let c ((<*> a) . h)   

instance (Applicative f) => Divisible (LetT f) where
    (</>) = flip Let

Procesadores de imagen

Con todos nuestros transformadores en su lugar, podemos comenzar a escribir nuestros procesadores de imágenes. En la parte inferior de nuestra pila tenemos nuestra ApT de una sección anterior

Ap (ApT IO)

Los cálculos deben poder leer el tiempo del entorno, por lo que agregaremos un ReaderT para ese

ReaderT Int (Ap (ApT IO))

Finalmente, nos gustaría poder compartir los cálculos, por lo que LetT transformador LetT en la parte superior, proporcionando todo el tipo de IP para nuestros procesadores de imágenes

type Image = String
type IP = LetT (ReaderT Int (Ap (ApT IO)))

Leeremos imágenes de IO . getLine hace divertidos ejemplos interactivos.

readImage :: Int -> IP Image
readImage n = liftLetT $ ReaderT (/t -> liftAp . liftIO $ do
    putStrLn $  "[" ++ show n ++ "] reading image for time: " ++ show t
    --getLine
    return $ "|image [" ++ show n ++ "] for time: " ++ show t ++ "|"
    )

Podemos cambiar el tiempo de las entradas

timeShift :: (Int -> Int) -> IP a -> IP a
timeShift f = mapLetT shift
    where
        shift (ReaderT g) = ReaderT (g . f)  

Añadir varias imágenes juntas

addImages :: Applicative f => [f Image] -> f Image
addImages = foldl (liftA2 (++)) (pure [])

Y voltear imágenes que pretenden usar alguna biblioteca que está atascada en IO . No pude imaginar cómo blur una cuerda ...

inIO :: (IO a -> IO b) -> IP a -> IP b
inIO = mapLetT . mapReaderT . mapApM        

flipImage :: IP [a] -> IP [a]
flipImage = inIO flip''
    where
        flip'' ma = do
            a <- ma
            putStrLn "flipping"
            return . reverse $ a

Interpretación LetT

Nuestra LetT para compartir resultados se encuentra en la parte superior de nuestra pila de transformadores. Tendremos que interpretarlo para obtener los cálculos debajo de él. Para interpretar LetT necesitaremos una forma de compartir resultados en IO , que proporciona memoize , y un interpeter que elimina el transformador LetT de la parte superior de la pila.

Para compartir cálculos, necesitamos almacenarlos en alguna parte, esto memoize un cómputo de IO en IO , asegurándose de que ocurra solo una vez, incluso a través de múltiples hilos.

memoize :: (Ord k) => (k -> IO a) -> IO (k -> IO a)
memoize definition = do
    cache <- newMVar Map.empty
    let populateCache k map = do
        case Map.lookup k map of
            Just a -> return (map, a)
            Nothing -> do
                a <- definition k
                return (Map.insert k a map, a)        
    let fromCache k = do
        map <- readMVar cache
        case Map.lookup k map of
            Just a -> return a
            Nothing -> modifyMVar cache (populateCache k)
    return fromCache

Para interpretar un Let , necesitamos un evaluador para el ApT IO subyacente para incorporarlo a las definiciones de los enlaces de Let . Dado que el resultado de los cálculos depende del entorno leído por ReaderT , incorporaremos tratar con ReaderT en este paso. Un enfoque más sofisticado usaría clases de transformadores, pero las clases de transformadores para Applicative es un tema para una pregunta diferente.

compileIP :: (forall x. ApT IO x -> IO x) ->  IP a -> IO (Int -> ApT IO a)
compileIP eval (NoLet (ReaderT f)) = return (stuffAp . f)
compileIP eval (Let b lf) = do
            cb <- compileIP eval b
            mb <- memoize (eval . cb)
            compileIP eval . lf . NoLet $ ReaderT (liftAp . lift . mb)

Interpretando ApT

Nuestro intérprete utiliza el siguiente State para evitar la necesidad de mirar dentro de AsT , FreeT y FreeF todo el tiempo.

data State m a where
    InPure :: a -> State m a
    InAp :: State m b -> State m (b -> State m a) -> State m a
    InM :: m a -> State m a

instance Functor m => Functor (State m) where
    fmap f (InPure a) = InPure (f a)
    fmap f (InAp b sa) = InAp b (fmap (fmap (fmap f)) sa)
    fmap f (InM  m)  = InM  (fmap f m)

Interpereting Ap es más difícil de lo que parece. El objetivo es tomar los datos que están en Ap.Pure y ponerlos en InPure y los datos que están en Ap y ponerlos en InAp . interpretAp realidad necesita llamarse a sí mismo con un tipo más grande cada vez que entra en un Ap más profundo; la función sigue captando otro argumento. El primer argumento t proporciona una forma de simplificar estos tipos que de otra manera explotarían.

interpretAp :: (Functor m) => (a -> State m b) -> Ap m a -> State m b
interpretAp t (Ap.Pure a) = t a
interpretAp t (Ap mb ap) = InAp sb sf
    where
        sb = InM mb
        sf = interpretAp (InPure . (t .)) $ ap

interperetApT obtiene datos de ApT , FreeT , y FreeF y en State m

interpretApT :: (Functor m, Monad m) => ApT m a -> m (State (ApT m) a)
interpretApT = (fmap inAp) . runApT
    where
        inAp (Pure a) = InPure a
        inAp (Free ap) = interpretAp (InM . ApT) $ ap

Con estas simples piezas de interpretación podemos hacer estrategias para interpretar los resultados. Cada estrategia es una función del State del intérprete a un nuevo State , con un posible efecto secundario en el camino. El orden que la estrategia elige para ejecutar los efectos secundarios determina el orden de los efectos secundarios. Haremos dos estrategias de ejemplo.

La primera estrategia realiza solo un paso en todo lo que está listo para ser calculado, y combina resultados cuando están listos. Esta es probablemente la estrategia que quieres.

stepFB :: (Functor m, Monad m) => State (ApT m) a -> m (State (ApT m) a)
stepFB (InM ma)   = interpretApT ma
stepFB (InPure a) = return (InPure a)
stepFB (InAp b f) = do
    sf <- stepFB f
    sb <- stepFB b
    case (sf, sb) of
        (InPure f, InPure b) -> return (f b)
        otherwise            -> return (InAp sb sf)

Esta otra estrategia realiza todos los cálculos tan pronto como los conoce. Los ejecuta a todos en un solo pase.

allFB :: (Functor m, Monad m) => State (ApT m) a -> m (State (ApT m) a)
allFB (InM ma) = interpretApT ma
allFB (InPure a) = return (InPure a)
allFB (InAp b f) = do
    sf <- allFB f
    sb <- allFB b
    case (sf, sb) of
        (InPure f, InPure b) -> return (f b)
        otherwise            -> allFB (InAp sb sf)

Muchas, muchas otras estrategias son posibles.

Podemos evaluar una estrategia ejecutándola hasta que produzca un único resultado.

untilPure :: (Monad m) => ((State f a) -> m (State f a)) -> State f a -> m a
untilPure s = go
    where
        go state =
            case state of
                (InPure a) -> return a
                otherwise  -> s state >>= go

Ejecutando el intepreter

Para ejecutar el intérprete, necesitamos algunos datos de ejemplo. Aquí hay algunos ejemplos interesantes.

example1  = (/i -> addImages [timeShift (*2) i, flipImage i]) </> readImage 1
example1'' = (/i -> addImages [timeShift (*2) i, flipImage i, flipImage . timeShift (*2) $ i]) </> readImage 1
example1'''' = (/i -> readImage 2) </> readImage 1
example2 = addImages [timeShift (*2) . flipImage $ readImage 1, flipImage $ readImage 2]

El intérprete de LetT necesita saber qué evaluador usar para los valores encuadernados, por lo que definiremos nuestro evaluador solo una vez. Un solo interpretApT inicia la evaluación al encontrar el State inicial del intérprete.

evaluator :: ApT IO x -> IO x
evaluator = (>>= untilPure stepFB) . interpretApT

Compilaremos example2 , que es esencialmente su ejemplo, y lo ejecutaremos por tiempo 5.

main = do
    f <- compileIP evaluator example2
    a <- evaluator . f $ 5
    print a

Lo cual produce casi el resultado deseado, con todas las lecturas sucediendo antes de cualquier volteo.

[2] reading image for time: 5
[1] reading image for time: 10
flipping
flipping
"|01 :emit rof ]1[ egami||5 :emit rof ]2[ egami|"