How can two continuations cancel each other out?

A function f :: a -> b can be "disguised" inside double continuations as a function f' :: ((a -> r1) -> r2) -> ((b -> r1) -> r2).

obfuscate :: (a -> b) -> ((a -> r1) -> r2) -> (b -> r1) -> r2
obfuscate f k2 k1 = k2 (k1 . f)

obfuscate has the nice property that it preserves function composition and identity: you can prove that obfuscate f . obfuscate g === obfuscate (f . g) and that obfuscate id === id in a few steps. That means that you can frequently use this transformation to untangle double-continuation computations that compose obfuscated functions together by factoring the obfuscate out of the composition. This question is an example of such an untangling.

The f in the top code block is the obfuscated version of the f in the bottom block (more precisely, top f x is the obfuscated version of bottom f x). You can see this by noticing how top f applies the outer continuation to a function that transforms its input and then applies the whole thing to the inner continuation, just like in the body of obfuscate.

So we can start to untangle zipRev:

zipRev xs ys = foldr f id xs snd (ys,[])
  where
    f x = obfuscate (\(y:ys,r) -> (ys,(x,y):r))

Since the action of foldr here is to compose a bunch of obfuscated functions with each other (and apply it all to id, which we can leave on the right), we can factor the obfuscate to the outside of the whole fold:

zipRev xs ys = obfuscate (\accum -> foldr f accum xs) id snd (ys,[])
  where
    f x (y:ys,r) = (ys,(x,y):r)

Now apply the definition of obfuscate and simplify:

zipRev xs ys = obfuscate (\accum -> foldr f accum xs) id snd (ys,[]) 
zipRev xs ys = id (snd . (\accum -> foldr f accum xs)) (ys,[])
zipRev xs ys = snd (foldr f (ys,[]) xs)

QED!


Let's try to understand this code from an elementary point of view. What does it even do, one wonders?

zipRev xs ys = foldr f id xs snd (ys,[])
  where
     -- f x k c = k (\(y:ys, r) -> c (ys, (x,y):r))
        f x k c = k (g x c) 
     --         = (k . g x) c   -- so,
     -- f x k   =  k . g x

        g x   c       (y:ys, r) =  c (ys, (x,y):r)

Here we used lambda lifting to recover the g combinator.

So then because f x k = k . g x were k goes to the left of x, the input list is translated into a reversed chain of compositions,

foldr f id [x1, x2, x3, ..., xn]   where  f x k = k . g x
  ===>> 
   (((...(id . g xn) .  ...  . g x3) . g x2) . g x1)

and thus, it just does what a left fold would do,

zipRev [] ys = []
zipRev [x1, x2, x3, ..., xn] ys 
      = (id . g xn  .  ...  . g x3 . g x2 . g x1)  snd         (ys, [])
      = g xn (g xn1 (  ...  ( g x3 ( g x2 ( g x1   snd)))...)) (ys, [])
   where     ----c--------------------------------------------
        g x  c     (y:ys, r) = c (ys, (x,y):r)

So we went to the deep end of the xs list, and then we come back consuming the ys list left-to-right (i.e. top-down) on our way back right-to-left on the xs list (i.e. bottom-up). This is straightforwardly coded as a right fold with strict reducer, so the flow is indeed right-to-left on the xs. The bottom-most action (snd) in the chain is done last, so in the new code it becomes the topmost (still done last):

zipRev xs ys = snd (foldr h (ys,[]) xs)
  where
        h x        (y:ys, r) =   (ys, (x,y):r)

g x c was used as a continuation in the original code, with c as a second-tier continuation; but it's actually all just been a regular fold from the right, all along.


So indeed it zips the reversed first list with the second. It's also unsafe; it misses a clause:

        g x  c     ([],   r) = c ([], r)        -- or just `r`
        g x  c     (y:ys, r) = c (ys, (x,y):r)

(update:) The answers by duplode (and Joseph Sible) do the lambda lifting a bit differently, in a way which is better suited to the task. It goes like this:

zipRev xs ys = foldr f id xs  snd (ys,[])
  where
     f x k c = k      (\((y:ys), r) -> c (ys, (x,y):r)) 
             = k (c . (\((y:ys), r) ->   (ys, (x,y):r)) )
             = k (c . g x)
     g x     =        (\((y:ys), r) ->   (ys, (x,y):r))
  {- f x k c = k ((. g x) c) = (k . (. g x)) c = (. (. g x)) k c
     f x     =                                   (. (. g x))     -}

so then

foldr f id  [ x1,            x2,    ... ,         xn      ]  snd  (ys,[]) =
  = ( (. (. g x1)) $ (. (. g x2)) $ ... $ (. (. g xn)) id )  snd  (ys,[])  -- 1,2...n
  = ( id . (. g xn) .  ...  . (. g x2)  .    (. g x1)     )  snd  (ys,[])  -- n...2,1
  =      ( snd . g x1 .    g x2   . ... .       g xn            ) (ys,[])  -- 1,2...n!
  =        snd $ g x1 $    g x2   $ ... $       g xn              (ys,[])
  =        snd $  foldr g (ys,[])  [x1, x2, ...,  xn      ]

Simple. :) Flipping twice is no flipping at all.


Given a function

g :: a₁ -> a₂

we can lift it to a function on continuations, switching the order:

lift g = (\c a₁ -> c (g a₁))
    :: (a₂ -> t) -> a₁ -> t

This transformation is a contravariant functor, which is to say that it interacts with function composition by switching its order:

g₁ :: a₁ -> a₂
g₂ :: a₂ -> a₃

lift g₁ . lift g₂
== (\c₁ a₁ -> c₁ (g₁ a₁)) . (\c₂ a₂ -> c₂ (g₂ a₂))
== \c₂ a₁ -> (\a₂ -> c₂ (g₂ a₂)) (g₁ a₁)
== \c₂ a₁ -> c₂ (g₂ (g₁ a₁)) 
== lift (g₂ . g₁)
    :: (a₃ -> t) -> a₁ -> t

lift id
== (\c a₁ -> c a₁)
== id
    :: (a₁ -> t) -> a₁ -> t

We can lift the lifted function again in the same way to a function on stacked continuations, with the order switched back:

lift (lift g)
== (\k c -> k ((\c a₁ -> c (g a₁)) c))
== (\k c -> k (\a₁ -> c (g a₁)))
    :: ((a₁ -> t) -> u) -> (a₂ -> t) -> u

Stacking two contravariant functors gives us a (covariant) functor:

lift (lift g₁) . lift (lift g₂)
== lift (lift g₂ . lift g₁)
== lift (lift (g₁ . g₂))
    :: ((a₁ -> t) -> u) -> (a₃ -> t) -> u

lift (lift id)
== lift id
== id
    :: ((a₁ -> t) -> u) -> (a₁ -> t) -> u

This is exactly the transformation being reversed in your example, with g = \(y:ys, r) -> (ys, (x, y):r). This g is an endomorphism (a₁ = a₂), and the foldr is composing together a bunch of copies of it with various x. What we’re doing is replacing the composition of double-lifted functions with the double-lift of the composition of the functions, which is just an inductive application of the functor laws:

f :: x -> a₁ -> a₁
c :: (a₁ -> t) -> u
xs :: [x]

foldr (\x -> lift (lift (f x))) c xs
== lift (lift (\a₁ -> foldr f a₁ xs)) c
    :: (a₁ -> t) -> u

Let's begin with a few cosmetic adjustments:

-- Note that `g x` is an endomorphism.
g :: a -> ([b], [(a,b)]) -> ([b], [(a,b)])
g x ((y:ys),r) = (ys,(x,y):r)

zipRev xs ys = foldr f id xs snd (ys,[])
  where
    f x k = \c -> k (c . g x)

f feeds a continuation (c . g x) to another function (k, a "double continuation", as user11228628 puts it).

While we might reasonably expect that repeated usage of f as the fold proceeds will somehow compose the g x endomorphisms made out of the elements of the list, the order in which the endomorphisms are composed might not be immediately obvious, so we'd better walk through a few fold steps to be sure:

-- x0 is the first element, x1 the second, etc.
f x0 k0 
\c -> k0 (c . g x0)
\c -> (f x1 k1) (c . g x0) -- k0 is the result of a fold step.
\c -> (\d -> k1 (d . g x1)) (c . g x0) -- Renaming a variable for clarity.
\c -> k1 (c . g x0 . g x1)
-- etc .
-- xa is the *last* element, xb the next-to-last, etc.
-- ka is the initial value passed to foldr.
\c -> (f xa ka) (c . g x0 . g x1 . . . g xb)
\c -> (\d -> ka (d . g xa)) (c . g x0 . g x1 . . . g xb)
\c -> ka (c . g x0 . g x1 . . . g xb . g xa)

ka, the initial value passed to foldr, is id, which makes things quite a bit simpler:

foldr f id xs = \c -> c . g x0 . g x1 . . . g xa

Since all we do with the c argument passed to foldr f id xs is post-composing it with the endomorphisms, we might as well factor it out of the fold:

zipRev xs ys = (snd . foldr h id xs) (ys,[])
  where
    h x e = g x . e

Note how we have gone from c . g x to g x . e. That can arguably be described as a collateral effect of the CPS trickery in the original implementation.

The final step is noticing how h x e = g x . e corresponds exactly to what we would do to implement foldr in terms of foldMap for the Endo monoid. Or, to put it more explicitly:

foldEndo g i xs = foldr g i xs  -- The goal is obtaining an Endo-like definition.

foldEndo _ i [] = i
foldEndo g i (x : xs) = g x (foldEndo g i xs)

foldEndo g i xs = go xs i
    where
    go [] = \j -> j
    go (x : xs) = \j -> g x (foldEndo g j xs)

foldEndo g i xs = go xs i
    where
    go [] = \j -> j
    go (x : xs) = \j -> g x (go xs j)

foldEndo g i xs = go xs i
    where
    go [] = id
    go (x : xs) = g x . go xs

foldEndo g i xs = go xs i
    where
    h x e = g x . e
    go [] = id
    go (x : xs) = h x (go xs)

foldEndo g i xs = go xs i
    where
    h x e = g x . e
    go xs = foldr h id xs

foldEndo g i xs = foldr h id xs i
    where
    h x e = g x . e

That finally leads us to what we were looking for:

zipRev xs ys = snd (foldr g (ys,[]) xs)