`DList`和`[]`之间的关系与Codensity_List_Haskell_Category Theory

`DList`和`[]`之间的关系与Codensity

list haskell

`DList`和`[]`之间的关系与Codensity,list,haskell,category-theory,List,Haskell,Category Theory,我最近一直在试验Codensity，它应该将DList与[]以及其他东西联系起来。无论如何，我从来没有找到说明这种关系的代码。经过一些实验后，我得出以下结论： {-# LANGUAGE RankNTypes #-} module Codensity where newtype Codensity f a = Codensity { runCodensity :: forall b. (a -> f b) -> f b } type DList a = Codensity []

我最近一直在试验

Codensity

，它应该将

DList

与

[]

以及其他东西联系起来。无论如何，我从来没有找到说明这种关系的代码。经过一些实验后，我得出以下结论：

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

然而，在我的示例中，

DList

的定义感觉有点恶心。有没有其他方式来表述这种关系？这是正确的方法吗？

一种观点可能是，

DList

是对monoid操作重新排序的方法，正如

Codensity

是对monad操作重新排序的方法一样

[]

是

上的一个自由幺半群，因此让我们使用一个自由编写器monad来表示列表，即

自由（，）a）

：

现在我们可以定义标准列表操作：

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

当涉及到

snoc

时，这种表示法与list具有相同的缺点。我们可以证实这一点

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

需要大量（二次）时间。然而，就像每一个免费的monad一样，它可以通过使用

Codensity

进行改进。我们只是将定义替换为

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

和

toList

with

toList = exec . lowerCodensity

现在，同一个表达式立即执行，就像原始差异列表一样，

Codensity

重新排序操作

TL；医生：

DList

for

（++）

的作用与

（>=）

的

Codensity

的作用相同：将运算符重新关联到右侧

这是有益的，因为对于

（++）

和

（>=）

，这两种方法都留下了相关的计算（可以）表现出二次运行时行为
1.全部故事计划如下：

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

我们一步一步地浏览
（++）
和
（>=）
的示例，用关联性来证明这个问题

我们使用CPS来避免使用
DList
和
Codensity

善后和奖金（从
（++）
概括为
（）
）

2.问题：二次运行时行为 2a。列表
（++）
请记住，当我使用
（++）
作为示例时，这是如果它们的工作方式类似于
（++）
，则对其他函数也有效
让我们先看看列表的问题。康卡特手术对于列表，通常是：
这意味着
（++）
将始终从从头到尾。要查看这是什么问题，请考虑以下事项两种计算：

as, bs, cs:: [Int] rightAssoc :: [Int] rightAssoc = (as ++ (bs ++ cs)) leftAssoc :: [Int] leftAssoc = ((as ++ bs) ++ cs)
让我们从
rightAssoc
开始，并逐步完成评估

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]
因此，我们必须将
作为
和
bs
进行浏览
好吧，那还不错，让我们继续
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]

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

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'))

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'))

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'))
哦，你看到了吗，我们不得不像那样走了两次？一度
[1,2]
，然后在
中再次使用as++bs=[1,2,3,4]
。各自进一步错误关联的操作数，左侧的列表每次我们必须完全遍历的
（++）
的数量将会增加每个步骤的时间越长，导致运行时行为二次性
正如您在上面看到的，关联的
（++）
将破坏性能。这导致我们：
2b。免费单子
（>>=）
请记住，当我使用
Free
作为示例时，这是其他单子的情况也是如此，例如
树的实例也像这样首先，我们使用naiveFree 类型： data Free f a = Pure a | Free (f (Free f a)) 我们不看（++），而是看（>>=），它是（>>=）前缀形式： instance Functor f => Monad (Free f) where return = Pure (>>=) (Pure a) f = f a (>>=) (Free m) f = Free ((>>= f) <$> m) 我们再次从rightAssoc 变量开始： 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)))))) 如果你仔细看，在呃哦之后，我们必须拆下再次使用中间结构，就像（++）的情况一样（也是标记为uh-oh ） 2c。迄今为止的结果在这两种情况下，leftAssoc都会导致二次运行时行为，因为我们多次重新构建第一个参数并将其撕掉再次右下角进行下一次操作。这意味着在每一步在评估中，我们必须建立并拆除一个不断增长的中间结构——不好 3.DList 与Codensity 在这里，我们将发现DList与 Codensity。每一个都解决了错误关联的问题通过使用CPS有效地重新关联到对 3a。数据列表首先，我们介绍DList 和append 的用法： 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 现在我们的老朋友们： 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) 评估大致如下： 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)) 哈！结果与2a 中的rightAssoc完全相同。好了，随着紧张局势的加剧，我们继续看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] 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)))))) 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')) 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')) 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')) 海瑞卡！结果正确关联（右侧），no 二次减速 3b。共同性好吧，如果你到了这一点，你一定很感兴趣，那很好，因为我也是：）。我们从Codensity的定义和Monad 实例开始（使用缩写名称）：我想你知道接下来会发生什么： 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) 在我们再次进行评估之前，您可能有兴趣比较DList中的append 和（>>=）中的 Codensity （unDL ~ 运行），如果需要，请继续执行想要，我会等你好的，我们从rightAssoc 开始： 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] 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)))))) 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')) 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')) 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')) 现在我们可以看到，（>>=）s与右侧关联，这考虑到情况也是如此，这还不是特别令人惊讶一开始。因此，满怀期待，我们将注意力转向我们的最后一次和最后一次评估跟踪，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] 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)))))) 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')) 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')) 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'))