for - Relación entre `DList` y`[] `con Codensity

category theory for programmers (2)

He estado experimentando con Codensity últimamente, que se supone que relaciona a DList con [] entre otras cosas. De todos modos, nunca he encontrado código que establezca esta relación. Después de algunos experimentos terminé con esto:

{-# LANGUAGE RankNTypes #-} module Codensity where newtype Codensity f a = Codensity { runCodensity :: forall b. (a -> f b) -> f b } type DList a = Codensity [] [a] nil :: DList a nil = Codensity ($ []) infixr 5 `cons` cons :: a -> DList a -> DList a cons x (Codensity xs) = Codensity ($ (xs (x:))) append :: DList a -> DList a -> DList a append (Codensity xs) ys = Codensity ($ (xs (++ toList ys))) toList :: DList a -> [a] toList xs = runCodensity xs id fromList :: [a] -> DList a fromList xs = Codensity (/k -> k xs)

Sin embargo, la definición de DList siente un poco complicada en mi ejemplo. ¿Hay una manera diferente de establecer esta relación? ¿Es esta incluso la manera correcta de hacer esto?

TL; DR: DList para (++) tiene el mismo propósito que Codensity para (>>=) : Codensity a Codensity los operadores a la derecha.
Esto es beneficioso, ya que para ambos, (++) y (>>=) , los cálculos asociados a la izquierda (can) muestran un comportamiento de tiempo de ejecución cuadrático .

1. La historia completa.

El plan es el siguiente:

Vamos paso a paso a través de un ejemplo para (++) y (>>=) , demostrando el problema con la asociatividad.
Usamos CPS para evitar la complejidad cuadrática con DList y Codensity
Consecuencias y bonificaciones (generalizar de (++) a (<>) )

2. El problema: el comportamiento cuadrático en tiempo de ejecución.

2a. Lista `(++)`

Tenga en cuenta que mientras uso (++) como ejemplo, esto también es válido para otras funciones, si funcionan de manera análoga a (++) .

Así que primero veamos el problema con las listas. La operación de concat para listas se define comúnmente como :

(++) [] ys = ys (++) (x:xs) ys = x : xs ++ ys

lo que significa que (++) siempre caminará el primer argumento de principio a fin. Para ver cuándo se trata de un problema, considere los siguientes dos cálculos:

as, bs, cs:: [Int] rightAssoc :: [Int] rightAssoc = (as ++ (bs ++ cs)) leftAssoc :: [Int] leftAssoc = ((as ++ bs) ++ cs)

Comencemos con rightAssoc y rightAssoc la evaluación.

as = [1,2] bs = [3,4] cs = [5,6] rightAssoc = ([1,2] ++ ([3,4] ++ [5,6])) -- pattern match gives (1:[2]) for first arg = 1 : ([2] ++ ([3,4] ++ [5,6])) -- pattern match gives (2:[]) for first arg = 1 : 2 : ([] ++ ([3,4] ++ [5,6])) -- first case of (++) = 1 : 2 : ([3,4] ++ [5,6]) = 1 : 2 : 3 : ([4] ++ [5,6]) = 1 : 2 : 3 : 4 : ([] ++ [5,6]) = 1 : 2 : 3 : 4 : [5,6] = [1,2,3,4,5,6]

Así que tenemos que caminar as y bs .

Bueno, eso no fue tan malo, continuemos a la leftAssoc :

as = [1,2] bs = [3,4] cs = [5,6] leftAssoc = (([1,2] ++ [3,4]) ++ [5,6]) = ((1 : ([2] ++ [3,4])) ++ [5,6]) = ((1 : 2 : ([] ++ [3,4])) ++ [5,6]) = ((1 : 2 : [3,4]) ++ [5,6]) = ([1,2,3,4] ++ [5,6]) -- uh oh = 1 : ([2,3,4] ++ [5,6]) = 1 : 2 : ([3,4] ++ [5,6]) = 1 : 2 : 3 : ([4] ++ [5,6]) = 1 : 2 : 3 : 4 : ([] ++ [5,6]) = 1 : 2 : 3 : 4 : [5,6] = [1,2,3,4,5,6]

Uh oh, ¿viste que tuvimos que caminar dos veces ? Una vez como [1,2] y luego otra vez dentro as ++ bs = [1,2,3,4] . Con cada operando adicional que está asociado erróneamente, la lista a la izquierda de (++) que tenemos que recorrer completamente cada vez crecerá en cada paso, lo que conducirá a un comportamiento de tiempo de ejecución cuadrático .

Entonces, como se ve arriba, los asociados a la izquierda (++) destruirán el rendimiento. Lo que nos lleva a:

2b. Mónada Libre `(>>=)`

Tenga en cuenta que mientras uso Free como ejemplo, este también es el caso de otras mónadas, por ejemplo, la instancia de Tree comporta de esta manera.

Primero, usamos el tipo Free ingenuo:

data Free f a = Pure a | Free (f (Free f a))

En lugar de (++) , observamos (>>=) que se define como y usamos (>>=) en forma de prefijo:

instance Functor f => Monad (Free f) where return = Pure (>>=) (Pure a) f = f a (>>=) (Free m) f = Free ((>>= f) <$> m)

Si comparas esto con la definición de (++) del 2a anterior, puedes ver que la definición de (>>=) mira nuevamente el primer argumento. Eso plantea una primera preocupación, ¿funcionará tan mal como en el caso (++) cuando se asocia incorrectamente? Bueno, veamos, uso la Identity aquí por simplicidad, pero la elección del functor no es el hecho importante aquí:

-- specialized to ''Free'' liftF :: Functor f => f a -> Free f a liftF fa = Free (Pure <$> fa) x :: Free Identity Int x = liftF (Identity 20) = Free (Identity (Pure 20)) f :: Int -> Free Identity Int f x = liftF (Identity (x+1)) = Free (Identity (Pure (x+1))) g :: Int -> Free Identity Int g x = liftF (Identity (x*2)) = Free (Identity (Pure (x*2))) rightAssoc :: Free Identity Int rightAssoc = (x >>= /x -> (f x >>= g)) leftAssoc :: Free Identity Int leftAssoc = ((x >>= f) >>= g)

Nuevamente comenzamos con la variante de rightAssoc primero:

rightAssoc = (x >>= /x -> (f x >>= g)) ~~~ -- definition of x = ((Free (Identity (Pure 20))) >>= /x -> (f x >>= g)) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- second case of definition for ''Free''s (>>=) = Free ((>>= /x -> (f x >>= g)) <$> Identity (Pure 20)) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- (<$>) for Identity = Free (Identity ((Pure 20) >>= /x -> (f x >>= g))) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- first case of the definition for ''Free''s (>>=) = Free (Identity (f 20 >>= g)) ~~~~ = Free (Identity ((Free (Identity (Pure 21))) >>= g)) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- second case of definition for ''Free''s (>>=) = Free (Identity (Free ((>>= g) <$> Identity (Pure 21)))) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ = Free (Identity (Free (Identity ((Pure 21) >>= g)))) ~~~~~~~~~~~~~~~ = Free (Identity (Free (Identity (g 21)))) ~~~~ = Free (Identity (Free (Identity (Free (Identity (Pure 42))))))

Puh, está bien, agregué ~~~~ bajo la expresión que se reduce en el siguiente paso para mayor claridad. Si rightAssoc lo suficiente, es posible que veas cierta familiaridad con el caso de 2a para el rightAssoc de rightAssoc : pasamos los dos primeros argumentos (ahora x y f lugar de as y bs ) los argumentos una vez. Sin perder más tiempo, aquí está leftAssoc :

leftAssoc = ((x >>= f) >>= g) ~~~ = ((Free (Identity (Pure 20)) >>= f) >>= g) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ = (Free ((>>= f) <$> Identity (Pure 20)) >>= g) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ = (Free (Identity ((Pure 20) >>= f)) >>= g) ~~~~~~~~~~~~~~~ = (Free (Identity (f 20)) >>= g) ~~~~ = (Free (Identity (Free (Identity (Pure 21)))) >>= g) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ = Free ((>>= g) <$> (Identity (Free (Identity (Pure 21))))) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- uh oh = Free (Identity (Free (Identity (Pure 21)) >>= g)) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ = Free (Identity (Free ((>>= g) <$> Identity (Pure 21)))) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ = Free (Identity (Free (Identity ((Pure 21) >>= g)))) ~~~~~~~~~~~~~~~~ = Free (Identity (Free (Identity (g 21)))) ~~~~ = Free (Identity (Free (Identity (Free (Identity (Pure 42))))))

Si miras de cerca, después de uh oh tenemos que derribar la estructura intermedia nuevamente, como en el caso (++) (también marcado con uh oh ).

2c. Resultado hasta ahora

En ambos casos, leftAssoc conduce a un comportamiento de tiempo de ejecución cuadrático, porque reconstruimos el primer argumento varias veces y lo leftAssoc nuevamente hacia la derecha para la siguiente operación. Esto significa que en cada paso de la evaluación tenemos que construir y derribar una estructura intermedia en crecimiento: mala.

3. La relación entre `DList` y `Codensity`

Aquí es donde descubriremos la relación entre DList y Codensity . Cada uno resuelve el problema de los cálculos asociados erróneamente vistos anteriormente mediante el uso de CPS para volver a asociarse efectivamente a la derecha.

3a. DList

Primero introducimos la definition de DList y DList :

newtype DList a = DL { unDL :: [a] -> [a] } append :: DList a -> DList a -> DList a append xs ys = DL (unDL xs . unDL ys) fromList :: [a] -> DList a fromList = DL . (++) toList :: DList a -> [a] toList = ($[]) . unDL

Y ahora nuestros viejos amigos:

as,bs,cs :: DList Int as = fromList [1,2] = DL ([1,2] ++) bs = fromList [3,4] = DL ([3,4] ++) cs = fromList [5,6] = DL ([5,6] ++) rightAssoc :: [Int] rightAssoc = toList $ as `append` (bs `append` cs) leftAssoc :: [Int] leftAssoc = toList $ ((as `append` bs) `append` cs)

La evaluación es aproximadamente como sigue:

rightAssoc = toList $ (DL ([1,2] ++)) `append` (bs `append` cs) = toList $ DL $ unDL (DL ([1,2] ++)) . unDL (bs `append` cs) ~~~~~~~~~~~~~~~~~~~~ = toList $ DL $ ([1,2] ++) . unDL (bs `append` cs) ~~ = toList $ DL $ ([1,2] ++) . unDL ((DL ([3,4] ++)) `append` cs) ~~~~~~~~~~~~~~~~~~~~~~~~~~~ = toList $ DL $ ([1,2] ++) . unDL (DL $ unDL (DL ([3,4] ++)) . unDL cs) ~~~~~~~~~~~~~~~~~~~~ = toList $ DL $ ([1,2] ++) . unDL (DL $ ([3,4] ++) . unDL cs) ~~ = toList $ DL $ ([1,2] ++) . unDL (DL $ ([3,4] ++) . unDL (DL ([5,6] ++))) = toList $ DL $ ([1,2] ++) . unDL (DL $ ([3,4] ++) . ([5,6] ++)) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ = toList $ DL $ ([1,2] ++) . (([3,4] ++) . ([5,6] ++)) ~~~~~~ -- definition of toList = ($[]) . unDL $ DL $ ([1,2] ++) . (([3,4] ++) . ([5,6] ++)) ~~~~~~~~~ -- unDL . DL == id = ($[]) $ (([1,2] ++) . (([3,4] ++) . ([5,6] ++))) -- move ($[]) to end = (([1,2] ++) . (([3,4] ++) . ([5,6] ++))) [] -- def: (.) g f x = g (f x) = (([1,2] ++) ((([3,4] ++) . ([5,6] ++)) [])) = (([1,2] ++) (([3,4] ++) (([5,6] ++) []))) -- drop unnecessary parens = (([1,2] ++) (([3,4] ++) ([5,6] ++ []))) = ([1,2] ++ ([3,4] ++ ([5,6] ++ []))) ~~~~~~~~~~~ -- (xs ++ []) == xs = ([1,2] ++ ([3,4] ++ ([5,6]))) = (as ++ (bs ++ cs))

Jah El resultado es exactamente el mismo que rightAssoc de 2a . Muy bien, con la tensión acumulada, nos movemos a la leftAssoc :

leftAssoc = toList $ ((as `append` bs) `append` cs) = toList $ (((DL ([1,2]++)) `append` bs) `append` cs) = toList $ ((DL (unDL (DL ([1,2]++)) . unDL bs)) `append` cs) = toList $ ((DL (unDL (DL ([1,2]++)) . unDL (DL ([3,4]++)))) `append` cs) = toList $ ((DL (([1,2]++) . ([3,4]++))) `append` cs) = toList $ (DL (unDL (DL (([1,2]++) . ([3,4]++))) . unDL cs)) = toList $ (DL (unDL (DL (([1,2]++) . ([3,4]++))) . unDL (DL ([5,6]++)))) = toList $ (DL ((([1,2]++) . ([3,4]++)) . ([5,6]++))) = ($[]) . unDL $ (DL ((([1,2]++) . ([3,4]++)) . ([5,6]++))) = ($[]) ((([1,2]++) . ([3,4]++)) . ([5,6]++)) = ((([1,2]++) . ([3,4]++)) . ([5,6]++)) [] -- expand (f . g) to /x -> f (g x) = ((/x -> ([1,2]++) (([3,4]++) x)) . ([5,6]++)) [] = ((/x -> ([1,2]++) (([3,4]++) x)) (([5,6]++) [])) -- apply lambda = ((([1,2]++) (([3,4]++) (([5,6]++) [])))) = ([1,2] ++ ([3,4] ++ [5,6])) = as'',bs'',cs'' ~ versions of 2a with no prime = (as'' ++ (bs'' ++ cs''))

Heureka! El resultado está asociado correctamente (a la derecha), sin ralentización cuadrática.

3b. Codensidad

De acuerdo, si has llegado a este punto, debes estar seriamente interesado, eso es bueno, porque yo también soy :). Comenzamos con la definición y la instancia de Monad de Codensity (con nombres abreviados):

newtype Codensity m a = C { run :: forall b. (a -> m b) -> m b } instance Monad (Codensity f) where return x = C (/k -> k x) m >>= k = C (/c -> run m (/a -> run (k a) c)) -- hidden as a instance for `MonadTrans` liftCodensity :: Monad m => m a -> Codensity m a liftCodensity m = C (m >>=) lowerCodensity :: Monad m => Codensity m a -> m a lowerCodensity a = run a return

Supongo que sabes lo que viene después:

x :: Codensity (Free Identity) Int x = liftCodensity (Free (Identity (Pure 20))) = C (Free (Identity (Pure 20)) >>=) -- note the similarity to (DL (as ++)) -- with DL ~ Codensity and (++) ~ (>>=) ! f :: Int -> Codensity (Free Identity) Int f x = liftCodensity (Free (Identity (Pure (x+1)))) = C (Free (Identity (Pure (x+1))) >>=) g :: Int -> Codensity (Free Identity) Int g x = liftCodensity (Free (Identity (Pure (x*2)))) = C (Free (Identity (Pure (x*2))) >>=) rightAssoc :: Free Identity Int rightAssoc = lowerCodensity (x >>= /x -> (f x >>= g)) leftAssoc :: Free Identity Int leftAssoc = lowerCodensity ((x >>= f) >>= g)

Antes de pasar por la evaluación una vez más, es posible que esté interesado en la comparación de los DList de DList y (>>=) de Codensity ( unDL ~ run ), siga adelante y haga eso si lo desea, lo esperaré.

Bien empezamos con rightAssoc :

rightAssoc = lowerCodensity (x >>= /x -> (f x >>= g)) ~~~ -- def of x = lowerCodensity ((C (Free (Identity (Pure 20)) >>=)) >>= /x -> (f x >>= g)) -- (>>=) of codensity = lowerCodensity (C (/c -> run (C (Free (Identity (Pure 20)) >>=)) (/a -> run ((/x -> (f x >>= g)) a) c))) -- run . C == id = lowerCodensity (C (/c -> Free (Identity (Pure 20)) >>= /a -> run ((/x -> (f x >>= g)) a) c)) -- substitute x'' for ''Free (Identity (Pure 20))'' (same as only x from 2b) = lowerCodensity (C (/c -> x'' >>= /a -> run ((/x -> (f x >>= g)) a) c)) ~~~ = lowerCodensity (C (/c -> x'' >>= /a -> run ((/x -> (C (Free (Identity (Pure (x+1))) >>=)) >>= g) a) c)) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ = lowerCodensity (C (/c -> x'' >>= /a -> run ((/x -> (C (/c2 -> run (C (Free (Identity (Pure (x+1))) >>=)) (/a2 -> run (g a2) c2)))) a) c)) ~~~~~~ = lowerCodensity (C (/c -> x'' >>= /a -> run ((/x -> (C (/c2 -> (Free (Identity (Pure (x+1))) >>=) (/a2 -> run (g a2) c2)))) a) c)) -- again, substitute f'' for ''/x -> Free (Identity (Pure (x+1)))'' (same as only f from 2b) = lowerCodensity (C (/c -> x'' >>= /a -> run ((/x -> (C (/c2 -> (f'' x >>=) (/a2 -> run (g a2) c2)))) a) c)) ~~~~ = lowerCodensity (C (/c -> x'' >>= /a -> run ((/x -> (C (/c2 -> (f'' x >>=) (/a2 -> run (C (Free (Identity (Pure (a2*2))) >>=)) c2)))) a) c)) ~~~~~~ = lowerCodensity (C (/c -> x'' >>= /a -> run ((/x -> (C (/c2 -> (f'' x >>=) (/a2 -> (Free (Identity (Pure (a2*2))) >>=) c2)))) a) c)) -- one last time, substitute g'' (g from 2b) = lowerCodensity (C (/c -> x'' >>= /a -> run ((/x -> (C (/c2 -> (f'' x >>=) (/a2 -> (g'' a2 >>=) c2)))) a) c)) -- def of lowerCodensity = run (C (/c -> x'' >>= /a -> run ((/x -> (C (/c2 -> (f'' x >>=) (/a2 -> (g'' a2 >>=) c2)))) a) c)) return = (/c -> x'' >>= /a -> run ((/x -> (C (/c2 -> (f'' x >>=) (/a2 -> (g'' a2 >>=) c2)))) a) c) return = (x'' >>= /a -> run ((/x -> (C (/c2 -> (f'' x >>=) (/a2 -> (g'' a2 >>=) c2)))) a) return) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ = (x'' >>= /a -> run (C (/c2 -> (f'' a >>=) (/a2 -> (g'' a2 >>=) c2))) return) ~~~~~~ = (x'' >>= /a -> (/c2 -> (f'' a >>=) (/a2 -> (g'' a2 >>=) c2)) return) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ = (x'' >>= /a -> (f'' a >>=) (/a2 -> g'' a2 >>= return)) -- m >>= return ~ m = (x'' >>= /a -> (f'' a >>=) (/a2 -> g'' a2)) -- m >>= (/x -> f x) ~ m >>= f = (x'' >>= /a -> (f'' a >>= g'')) -- rename a to x = (x'' >>= /x -> (f'' x >>= g''))

Y ahora podemos ver que los (>>=) s están asociados a la derecha, esto todavía no es particularmente sorprendente, dado que este fue también el caso al comienzo. Entonces, llenos de anticipación, dirigimos nuestra atención a nuestro último y último seguimiento de evaluación, leftAssoc :

leftAssoc = lowerCodensity ((x >>= f) >>= g) -- def of x = lowerCodensity ((C (Free (Identity (Pure 20)) >>=) >>= f) >>= g) -- (>>=) from Codensity = lowerCodensity ((C (/c -> run (C (Free (Identity (Pure 20)) >>=)) (/a -> run (f a) c))) >>= g) ~~~~~~ = lowerCodensity ((C (/c -> (Free (Identity (Pure 20)) >>=) (/a -> run (f a) c))) >>= g) -- subst x'' = lowerCodensity ((C (/c -> (x'' >>=) (/a -> run (f a) c))) >>= g) -- def of f = lowerCodensity ((C (/c -> (x'' >>=) (/a -> run (C (Free (Identity (Pure (a+1))) >>=)) c))) >>= g) ~~~~~~ = lowerCodensity ((C (/c -> (x'' >>=) (/a -> (Free (Identity (Pure (a+1))) >>=) c))) >>= g) -- subst f'' = lowerCodensity ((C (/c -> (x'' >>=) (/a -> (f'' a >>=) c))) >>= g) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ = lowerCodensity (C (/c2 -> run (C (/c -> (x'' >>=) (/a -> (f'' a >>=) c))) (/a2 -> run (g a2) c2))) ~~~~~~ = lowerCodensity (C (/c2 -> (/c -> (x'' >>=) (/a -> (f'' a >>=) c)) (/a2 -> run (g a2) c2))) -- def of g = lowerCodensity (C (/c2 -> (/c -> (x'' >>=) (/a -> (f'' a >>=) c)) (/a2 -> run (C (Free (Identity (Pure (a2*2))) >>=)) c2))) ~~~~~~ = lowerCodensity (C (/c2 -> (/c -> (x'' >>=) (/a -> (f'' a >>=) c)) (/a2 -> (Free (Identity (Pure (a2*2))) >>=) c2))) -- subst g'' = lowerCodensity (C (/c2 -> (/c -> (x'' >>=) (/a -> (f'' a >>=) c)) (/a2 -> (g'' a2 >>=) c2))) -- def lowerCodensity = run (C (/c2 -> (/c -> (x'' >>=) (/a -> (f'' a >>=) c)) (/a2 -> (g'' a2 >>=) c2))) return = (/c2 -> (/c -> (x'' >>=) (/a -> (f'' a >>=) c)) (/a2 -> (g'' a2 >>=) c2)) return = ((/c -> (x'' >>=) (/a -> (f'' a >>=) c)) (/a2 -> g'' a2 >>= return)) = ((/c -> (x'' >>=) (/a -> (f'' a >>=) c)) (/a2 -> g'' a2)) = ((/c -> (x'' >>=) (/a -> (f'' a >>=) c)) g'') = (x'' >>=) (/a -> (f'' a >>=) g'') = (x'' >>=) (/a -> (f'' a >>= g'') = (x'' >>= (/a -> (f'' a >>= g'')) = (x'' >>= (/x -> (f'' x >>= g''))

Finalmente ahí lo tenemos, todos los enlaces asociados a la derecha, ¡exactamente como nos gustan!

4. secuelas

Si lo hiciste hasta aquí, felicidades. Vamos a resumir lo que hicimos:

Demostramos el problema con una asociación errónea (++) en 2a y (>>=) en 2b
Hemos mostrado la solución utilizando DList en 3a y Codensity en 3b .
Demostrado el poder del razonamiento ecuacional en Haskell :)

5. Bonificación

De hecho, podemos generalizar DList desde (++) y usar (<>) para obtener DMonoid , reordenar (<>) .

newtype DMonoid m = DM { unDM :: m -> m } instance Monoid m => Monoid (DMonoid m) where mempty = DM (mempty <>) x `mappend` y = DM (unDM x . unDM y) liftDM :: Monoid m => m -> DMonoid m liftDM = DM . (<>) lowerDM :: Monoid m => DMonoid m -> m lowerDM = ($ mempty) . unDM

Entonces la comparación es la siguiente:

DMonoid es un "transformador monoide " (mi invención), que se DMonoid (<>) a la derecha
Codensity es un transformador de mónada, que se asocia de nuevo (>>=) a la derecha

Una visión podría ser que DList es una forma de reordenar las operaciones de Codensity , al igual que Codensity es una forma de reordenar las operaciones de Codensity .

[] es un monoide gratuito en a , así que representemos listas usando una mónada de escritor libre, que es Free ((,) a) :

module Codensity where import Control.Monad import Control.Monad.Free import Control.Monad.Codensity import Control.Monad.Trans (lift) type DList a = Free ((,) a) ()

Ahora podemos definir las operaciones de lista estándar:

nil :: DList a nil = return () singleton :: a -> DList a singleton x = liftF (x, ()) append :: DList a -> DList a -> DList a append = (>>) infixr 5 `snoc` snoc :: DList a -> a -> DList a snoc xs x = xs >> singleton x exec :: Free ((,) a) () -> [a] exec (Free (x, xs)) = x : exec xs exec (Pure _) = [] fromList :: [a] -> DList a fromList = mapM_ singleton toList :: DList a -> [a] toList = exec

Esta representación tiene los mismos inconvenientes que la lista cuando se trata de snoc . Podemos verificar que

last . toList . foldl snoc nil $ [1..10000]

toma una cantidad significativa (cuadrática) de tiempo. Sin embargo, al igual que todas las mónadas gratuitas, se puede mejorar utilizando Codensity . Simplemente reemplazamos la definición con

type DList a = Codensity (Free ((,) a)) ()

y toList con

toList = exec . lowerCodensity

Ahora, la misma expresión se ejecuta instantáneamente, ya que Codensity reordena las operaciones, al igual que las listas de diferencias originales.