How to adapt trampolines to Continuation Passing Style?

Question

Here is a naive implementation of a right fold:

const foldr = f => acc => ([x, ...xs]) =>
  x === undefined
    ? acc 
    : f(x) (foldkr(f) (acc) (xs));

This is non-tail recursion and hence we cannot apply a trampoline. One approach would be to make the algorithm iterative and use a stack to mimick the function call stack.

Another approch would be to transform the recursion into CPS:

const Cont = k => ({runCont: k});

const foldkr = f => acc => ([x, ...xs]) =>
  Cont(k =>
    x === undefined
      ? k(acc)
      : foldkr(f) (acc) (xs)
          .runCont(acc_ => k(f(x) (acc_))));

This is still naive, because it is insanely slow. Here is a less memory consuming version:

const foldkr = f => acc => xs => {
  const go = i =>
    Cont(k =>
      i === xs.length
        ? k(acc)
        : go(i + 1)
            .runCont(acc_ => k(f(xs[i]) (acc_))));

  return go(0);
};

The recursive call is now in tail position hence we should be able to apply a trampoline of our choice:

const loop = f => {
  let step = f();

  while (step && step.type === recur)
    step = f(...step.args);

  return step;
};

const recur = (...args) =>
  ({type: recur, args});

const foldkr = f => acc => xs =>
  loop((i = 0) => 
    Cont(k =>
      i === xs.length
        ? k(acc)
        : recur(i + 1)
            .runCont(acc_ => k(f(xs[i]) (acc_)))));

This doesn't work, because the trampoline call is inside the continuation and thus lazily evaluated. How must the trampoline be adapted so that it works with CPS?

Slang

You cannot make an efficient right-fold unless you either make f lazy or iterate from the right. – Midsummer

@Midsummer Do you mean lazy in the 2nd argument like in Haskell? – Slang

go(i + 1).runCont(...) does not have go in tail position -runCont is the tail call – Brown

@user633183 Are you sure about this? Because if it weren't for the Cont wrappper there would be just another function call. – Slang

Ah, it is probably tail call modulo Cont – Slang

yes very sure; go() runs and finishes to give {runCont: ...} then .runCont(...) is called – Brown

Answer 1

tail calls first (part 1)

First write the loop such that it recurs in tail position

const foldr = (f, init, xs = []) =>
  loop
    ( ( i = 0
      , k = identity
      ) =>
        i >= xs.length 
          ? k (init)
          : recur
              ( i + 1
              , r => k (f (r, xs[i]))
              )
   )

Given two inputs, small and large, we test foldr -

const small =
  [ 1, 2, 3 ]

const large =
  Array.from (Array (2e4), (_, n) => n + 1)

foldr ((a, b) => `(${a}, ${b})`, 0, small)
// => (((0, 3), 2), 1)

foldr ((a, b) => `(${a}, ${b})`, 0, large)
// => RangeError: Maximum call stack size exceeded

But it uses a trampoline, why does it fail for large? The short answer is because we built a huge deferred computation, k ...

loop
  ( ( i = 0
    , k = identity // base computation
    ) =>
      // ...
      recur // this gets called 20,000 times
        ( i + 1
        , r => k (f (r, xs[i])) // create new k, deferring previous k
        )
  )

In the terminating condition, we finally call k(init) which fires off the stack of deferred computations, 20,000 function calls deep, which triggers the stack-overflow.

Before reading on, expand the snippet below to make sure we're on the same page -

const identity = x =>
  x
  
const loop = f =>
{ let r = f ()
  while (r && r.recur === recur)
    r = f (...r.values)
  return r
}

const recur = (...values) =>
  ({ recur, values })

const foldr = (f, init, xs = []) =>
  loop
    ( ( i = 0
      , k = identity
      ) =>
        i >= xs.length 
          ? k (init)
          : recur
              ( i + 1
              , r => k (f (r, xs[i]))
              )
   )

const small =
  [ 1, 2, 3 ]

const large =
  Array.from (Array (2e4), (_, n) => n + 1)

console.log(foldr ((a, b) => `(${a}, ${b})`, 0, small))
// (((0, 3), 2), 1)

console.log(foldr ((a, b) => `(${a}, ${b})`, 0, large))
// RangeError: Maximum call stack size exceeded

---

deferred overflow

The problem we're seeing here is the same one you might encounter if you were to compose(...) or pipe(...) 20,000 functions together -

// build the composition, then apply to 1
foldl ((r, f) => (x => f (r (x))), identity, funcs) (1)

Or similar using comp -

const comp = (f, g) =>
  x => f (g (x))

// build the composition, then apply to 1
foldl (comp, identity, funcs) 1

Sure, foldl is stack-safe and it can compose 20,000 functions, but as soon as you call the massive composition, you risk blowing the stack. Now compare that to -

// starting with 1, fold the list; apply one function at each step
foldl ((r, f) => f (r), 1, funcs)

... which does not blow the stack because the computations are not deferred. Instead the result from one step overwrites the result from the previous step until the final step is reached.

In fact, when we write -

r => k (f (r, xs[i]))

Another way to see this is -

comp (k, r => f (r, xs[i]))

This should highlight exactly where the problem is.

---

possible solution

One simple remedy is to add a separate call tag that flattens the deferred computation in the trampoline. So instead of calling a function directly like f (x), we'll write call (f, x) -

const call = (f, ...values) =>
  ({ call, f, values })

const foldr = (f, init, xs = []) =>
  loop
    ( ( i = 0
      , k = identity
      ) =>
        i >= xs.length 
          // k (init) rewrite as
          ? call (k, init)
          : recur
              ( i + 1
              // r => k (f (r, xs[i])) rewrite as
              , r => call (k, f (r, xs[i]))
              )
   )

We modify the trampoline to act on call-tagged values -

const loop = f =>
{ let r = f ()
  while (r)
    if (r.recur === recur)
      r = f (...r.values)
    else if (r.call === call)
      r = r.f (...r.values)
    else
      break
  return r
}

Finally, we see that the large input no longer overflows the stack -

foldr ((a, b) => `(${a}, ${b})`, 0, small)
// => (((0, 3), 2), 1)

foldr ((a, b) => `(${a}, ${b})`, 0, large)
// => (Press "Run snippet" below see results ...)

const identity = x =>
  x
  
const loop = f =>
{ let r = f ()
  while (r)
    if (r.recur === recur)
      r = f (...r.values)
    else if (r.call === call)
      r = r.f (...r.values)
    else
      break
  return r
}

const recur = (...values) =>
  ({ recur, values })
  
const call = (f, ...values) =>
  ({ call, f, values })

const foldr = (f, init, xs = []) =>
  loop
    ( ( i = 0
      , k = identity
      ) =>
        i >= xs.length 
          ? call (k, init)
          : recur
              ( i + 1
              , r => call (k, f (r, xs[i]))
              )
   )
   
const small =
  [ 1, 2, 3 ]

const large =
  Array.from (Array (2e4), (_, n) => n + 1)

console.log(foldr ((a, b) => `(${a}, ${b})`, 0, small))
// (((0, 3), 2), 1)

console.log(foldr ((a, b) => `(${a}, ${b})`, 0, large))
// (Press "Run snippet" to see results ...)

---

wups, you built your own evaluator

Above, recur and call appear to be magic functions. But in reality, recur and call create simple objects { ... } and loop is doing all of the work. In this way, loop is a type of evaluator that accepts recur and call expressions. The one down-side to this solution is that we expect the caller always to use recur or call in tail position, otherwise the loop will return an incorrect result.

This is different than the Y-combinator which reifies the recursion mechanism as a parameter, and is not limited to a tail-only position, such as recur here -

const Y = f => f (x => Y (f) (x))

const fib = recur => n =>
  n < 2
    ? n
    : recur (n - 1) + recur (n - 2) // <-- non-tail call supported
    
console .log (Y (fib) (30))
// => 832040

The one down-side to Y is, of course, because you control recursion by calling a function, you are still stack-unsafe just like all other functions in JS. The result is a stack-overflow -

console .log (Y (fib) (100))
// (After a long time ...)
// RangeError: Maximum call stack size exceeded

So would it be possible to support recur in non-tail position and remain stack-safe? Sure, a sufficiently clever loop should be able evaluate recursive expressions -

const fib = (init = 0) =>
  loop
    ( (n = init) =>
        n < 2
          ? n
          : call
              ( (a, b) => a + b
              , recur (n - 1)
              , recur (n - 2)
              ) 
    )

fib (30)
// expected: 832040

loop becomes a CPS tail-recursive function for evaluating the input expressions call, recur, etc. Then we put loop on a trampoline. loop effectively becomes an evaluator for our custom language. Now you can forget all about the stack – your only limitation now is memory!

Alternatively -

const fib = (n = 0) =>
  n < 2
    ? n
    : call
        ( (a, b) => a + b
        , call (fib, n - 1)
        , call (fib, n - 2)
        )

loop (fib (30))
// expected: 832040

In this related Q&A, I write a normal-order evaluator for untyped lambda calculus in JavaScript. It shows how you can write programs that are freed from the implementation effects (evaluation strategy, stack model, etc) of the host language. There we're using Church-encoding, here were using call and recur, but the technique is the same.

Years back, I wrote a stack-safe variation using the technique I described above. I'll see if I can ressurrect it and later make it available in this answer. For now, I'll leave the loop evaluator as an exercise for the reader.

PART 2 added: loop evaluator

---

alternative solution

In this related Q&A, we build a stack-safe continuation monad.

Brown

I know you for around three years now and am still as astonished as on the first day I met you. Your code (and the underlying ideas) is the reification of a beautiful mind. Best wishes across the ocean. – Slang

Your words mean a lot to me. Thank you for giving me a chance to discuss these ideas and problems with a kindred soul. I've learned much from our exchanges. Cheers! – Brown

Sorry, I couldn't help myself. I added a second answer which answers your question more directly, I think. – Brown

Answer 2

yes, yes, and yes (part 2)

So I believe this answer gets closer to the core of your question – can we make any recursive program stack-safe? Even if recursion isn't in tail position? Even if the host language doesn't have tail-call elimination? Yes. Yes. And yes – with one small requirement...

The end of my first answer talked about loop as a sort of evaluator and then described a rough idea of how it would be implemented. The theory sounded good but I wanted to make sure the technique works in practice. So here we go!

---

non-trivial program

Fibonacci is great for this. The binary recursion implementation builds a big recursive tree and neither recursive call is in tail position. If we can get this program right, we can have reasonable confidence we implemented loop correctly.

And here's that small requirement: You cannot call a function to recur. Instead of f (x), you will write call (f, x) –

const add = (a = 0, b = 0) =>
  a + b

const fib = (init = 0) =>
  loop
    ( (n = init) =>
        n < 2
          ? n
          : add (recur (n - 1), recur (n - 2))
          : call (add, recur (n - 1), recur (n - 2))
    )

fib (10)
// => 55

But these call and recur functions are nothing special. They only create ordinary JS objects –

const call = (f, ...values) =>
  ({ type: call, f, values })

const recur = (...values) =>
  ({ type: recur, values })

So in this program, we have a call that depends on two recurs. Each recur has the potential to spawn yet another call and additional recurs. A non-trivial problem indeed, but in reality we're just dealing with a well-defined recursive data structure.

---

writing loop

If loop is going to process this recursive data structure, it'll be easiest if we can write loop as a recursive program. But aren't we just going to run into a stack-overflow somewhere else then? Let's find out!

// loop : (unit -> 'a expr) -> 'a
const loop = f =>
{ // aux1 : ('a expr, 'a -> 'b) -> 'b 
  const aux1 = (expr = {}, k = identity) =>
    expr.type === recur
      ? // todo: when given { type: recur, ... }
  : expr.type === call
      ? // todo: when given { type: call, ... }
  : k (expr) // default: non-tagged value; no further evaluation necessary

  return aux1 (f ())
}

So loop takes a function to loop, f. We expect f to return an ordinary JS value when the computation is completed. Otherwise return either call or recur to grow the computation.

These todos are somewhat trivial to fill in. Let's do that now –

// loop : (unit -> 'a expr) -> 'a
const loop = f =>
{ // aux1 : ('a expr, 'a -> 'b) -> 'b 
  const aux1 = (expr = {}, k = identity) =>
    expr.type === recur
      ? aux (expr.values, values => aux1 (f (...values), k))
  : expr.type === call
      ? aux (expr.values, values => aux1 (expr.f (...values), k))
  : k (expr)

  // aux : (('a expr) array, 'a array -> 'b) -> 'b
  const aux = (exprs = [], k) =>
    // todo: implement me

  return aux1 (f ())
}

So intuitively, aux1 (“auxiliary one”) is the magic wand we wave over one expression, expr, and the result comes back in the continuation. In other words –

// evaluate expr to get the result
aux1 (expr, result => ...)

To evaluate recur or call, we must first evaluate the corresponding values. We wish we could write something like –

// can't do this!
const r =
  expr.values .map (v => aux1 (v, ...))

return k (expr.f (...r))

What would the continuation ... be? We can't call aux1 in .map like that. Instead, we need another magic wand that can take an array of expressions, and pass the resulting values to its continuation; such as aux –

// evaluate each expression and get all results as array
aux (expr.values, values => ...)

---

meat & potatoes

Ok, this is the probably the toughest part of the problem. For each expression in the input array, we have to call aux1 and chain the continuation to the next expression, finally passing the values to the user-supplied continuation, k –

// aux : (('a expr) array, 'a array -> 'b) -> 'b
const aux = (exprs = [], k) =>
  exprs.reduce
    ( (mr, e) =>
        k => mr (r => aux1 (e, x => k ([ ...r, x ])))
    , k => k ([])
    )
    (k)

We won't end up using this, but it helps to see what we're doing in aux expressed as an ordinary reduce and append –

// cont : 'a -> ('a -> 'b) -> 'b
const cont = x =>
  k => k (x)

// append : ('a array, 'a) -> 'a array
const append = (xs, x) =>
  [ ...xs, x ]

// lift2 : (('a, 'b) -> 'c, 'a cont, 'b cont) -> 'c cont
const lift2 = (f, mx, my) =>
  k => mx (x => my (y => k (f (x, y))))

// aux : (('a expr) array, 'a array -> 'b) -> 'b
const aux = (exprs = [], k) =>
  exprs.reduce
    ( (mr, e) =>
        lift2 (append, mr, k => aux1 (e, k))
    , cont ([])
    )

Putting it all together we get –

// identity : 'a -> 'a
const identity = x =>
  x

// loop : (unit -> 'a expr) -> 'a
const loop = f =>
{ // aux1 : ('a expr, 'a -> 'b) -> 'b 
  const aux1 = (expr = {}, k = identity) =>
    expr.type === recur
      ? aux (expr.values, values => aux1 (f (...values), k))
  : expr.type === call
      ? aux (expr.values, values => aux1 (expr.f (...values), k))
  : k (expr)

  // aux : (('a expr) array, 'a array -> 'b) -> 'b
  const aux = (exprs = [], k) =>
    exprs.reduce
      ( (mr, e) =>
          k => mr (r => aux1 (e, x => k ([ ...r, x ])))
      , k => k ([])
      )
      (k)

  return aux1 (f ())
}

Time for a little celebration –

fib (10)
// => 55

But only a little –

fib (30)
// => RangeError: Maximum call stack size exceeded

---

your original problem

Before we attempt to fix loop, let's revisit the program in your question, foldr, and see how it's expressed using loop, call, and recur –

const foldr = (f, init, xs = []) =>
  loop
    ( (i = 0) =>
        i >= xs.length
          ? init
          : f (recur (i + 1), xs[i])
          : call (f, recur (i + 1), xs[i])
    )

And how does it work?

// small : number array
const small =
  [ 1, 2, 3 ]

// large : number array
const large =
  Array .from (Array (2e4), (_, n) => n + 1)

foldr ((a, b) => `(${a}, ${b})`, 0, small)
// => (((0, 3), 2), 1)

foldr ((a, b) => `(${a}, ${b})`, 0, large)
// => RangeError: Maximum call stack size exceeded

Okay, it works but for small but it blows up the stack for large. But this is what we expected, right? After all, loop is just an ordinary recursive function, bound for an inevitable stack-overflow... right?

Before we go on, verify the results to this point in your own browser –

// call : (* -> 'a expr, *) -> 'a expr
const call = (f, ...values) =>
  ({ type: call, f, values })

// recur : * -> 'a expr
const recur = (...values) =>
  ({ type: recur, values })

// identity : 'a -> 'a
const identity = x =>
  x

// loop : (unit -> 'a expr) -> 'a
const loop = f =>
{ // aux1 : ('a expr, 'a -> 'b) -> 'b
  const aux1 = (expr = {}, k = identity) =>
    expr.type === recur
      ? aux (expr.values, values => aux1 (f (...values), k))
  : expr.type === call
      ? aux (expr.values, values => aux1 (expr.f (...values), k))
  : k (expr)

  // aux : (('a expr) array, 'a array -> 'b) -> 'b
  const aux = (exprs = [], k) =>
    exprs.reduce
      ( (mr, e) =>
          k => mr (r => aux1 (e, x => k ([ ...r, x ])))
      , k => k ([])
      )
      (k)

  return aux1 (f ())
}

// fib : number -> number
const fib = (init = 0) =>
  loop
    ( (n = init) =>
        n < 2
          ? n
          : call
              ( (a, b) => a + b
              , recur (n - 1)
              , recur (n - 2)
              )
    )

// foldr : (('b, 'a) -> 'b, 'b, 'a array) -> 'b
const foldr = (f, init, xs = []) =>
  loop
    ( (i = 0) =>
        i >= xs.length
          ? init
          : call (f, recur (i + 1), xs[i])
    )

// small : number array
const small =
  [ 1, 2, 3 ]

// large : number array
const large =
  Array .from (Array (2e4), (_, n) => n + 1)

console .log (fib (10))
// 55

console .log (foldr ((a, b) => `(${a}, ${b})`, 0, small))
// (((0, 3), 2), 1)

console .log (foldr ((a, b) => `(${a}, ${b})`, 0, large))
// RangeError: Maximum call stack size exc

---

bouncing loops

I have too many answers on converting functions to CPS and bouncing them using trampolines. This answer isn't going focus on that much. Above we have aux1 and aux as CPS tail-recursive functions. The following transformation can be done in a mechanical way.

Like we did in the other answer, for every function call we find, f (x), convert it to call (f, x) –

// loop : (unit -> 'a expr) -> 'a
const loop = f =>
{ // aux1 : ('a expr, 'a -> 'b) -> 'b
  const aux1 = (expr = {}, k = identity) =>
    expr.type === recur
      ? call (aux, expr.values, values => call (aux1, f (...values), k))
  : expr.type === call
      ? call (aux, expr.values, values => call (aux1, expr.f (...values), k))
  : call (k, expr)

  // aux : (('a expr) array, 'a array -> 'b) -> 'b
  const aux = (exprs = [], k) =>
    call
      ( exprs.reduce
          ( (mr, e) =>
              k => call (mr, r => call (aux1, e, x => call (k, [ ...r, x ])))
          , k => call (k, [])
          )
      , k
      )

  return aux1 (f ())
  return run (aux1 (f ()))
}

Wrap the return in run, which is a simplified trampoline –

// run : * -> *
const run = r =>
{ while (r && r.type === call)
    r = r.f (...r.values)
  return r
}

And how does it work now?

// small : number array
const small =
  [ 1, 2, 3 ]

// large : number array
const large =
  Array .from (Array (2e4), (_, n) => n + 1)

fib (30)
// 832040

foldr ((a, b) => `(${a}, ${b})`, 0, small)
// => (((0, 3), 2), 1)

foldr ((a, b) => `(${a}, ${b})`, 0, large)
// => (Go and see for yourself...)

Witness stack-safe recursion in any JavaScript program by expanding and running the snippet below –

// call : (* -> 'a expr, *) -> 'a expr
const call = (f, ...values) =>
  ({ type: call, f, values })

// recur : * -> 'a expr
const recur = (...values) =>
  ({ type: recur, values })

// identity : 'a -> 'a
const identity = x =>
  x

// loop : (unit -> 'a expr) -> 'a
const loop = f =>
{ // aux1 : ('a expr, 'a -> 'b) -> 'b
  const aux1 = (expr = {}, k = identity) =>
    expr.type === recur
      ? call (aux, expr.values, values => call (aux1, f (...values), k))
  : expr.type === call
      ? call (aux, expr.values, values => call (aux1, expr.f (...values), k))
  : call (k, expr)

  // aux : (('a expr) array, 'a array -> 'b) -> 'b
  const aux = (exprs = [], k) =>
    call
      ( exprs.reduce
          ( (mr, e) =>
              k => call (mr, r => call (aux1, e, x => call (k, [ ...r, x ])))
          , k => call (k, [])
          )
      , k
      )

  return run (aux1 (f ()))
}

// run : * -> *
const run = r =>
{ while (r && r.type === call)
    r = r.f (...r.values)
  return r
}

// fib : number -> number
const fib = (init = 0) =>
  loop
    ( (n = init) =>
        n < 2
          ? n
          : call
              ( (a, b) => a + b
              , recur (n - 1)
              , recur (n - 2)
              )
    )

// foldr : (('b, 'a) -> 'b, 'b, 'a array) -> 'b
const foldr = (f, init, xs = []) =>
  loop
    ( (i = 0) =>
        i >= xs.length
          ? init
          : call (f, recur (i + 1), xs[i])
    )

// small : number array
const small =
  [ 1, 2, 3 ]

// large : number array
const large =
  Array .from (Array (2e4), (_, n) => n + 1)

console .log (fib (30))
// 832040

console .log (foldr ((a, b) => `(${a}, ${b})`, 0, small))
// (((0, 3), 2), 1)

console .log (foldr ((a, b) => `(${a}, ${b})`, 0, large))
// YES! YES! YES!

---

evaluation visualisation

Let's evaluate a simple expression using foldr and see if we can peer into how loop does its magic –

const add = (a, b) =>
  a + b

foldr (add, 'z', [ 'a', 'b' ])
// => 'zba'

You can follow along by pasting this in a text-editor that supports bracket highlighting –

// =>
aux1
  ( call (add, recur (1), 'a')
  , identity
  )

// =>
aux1
  ( { call
    , f: add
    , values:
        [ { recur, values: [ 1 ]  }
        , 'a'
        ]
    }
  , identity
  )

// =>
aux
  ( [ { recur, values: [ 1 ]  }
    , 'a'
    ]
  , values => aux1 (add (...values), identity)
  )

// =>
[ { recur, values: [ 1 ]  }
, 'a'
]
.reduce
  ( (mr, e) =>
      k => mr (r => aux1 (e, x => k ([ ...r, x ])))
  , k => k ([])
  )
(values => aux1 (add (...values), identity))

// beta reduce outermost k
(k => (k => (k => k ([])) (r => aux1 ({ recur, values: [ 1 ]  }, x => k ([ ...r, x ])))) (r => aux1 ('a', x => k ([ ...r, x ])))) (values => aux1 (add (...values), identity))

// beta reduce outermost k
(k => (k => k ([])) (r => aux1 ({ recur, values: [ 1 ]  }, x => k ([ ...r, x ])))) (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ])))

// beta reduce outermost k
(k => k ([])) (r => aux1 ({ recur, values: [ 1 ]  }, x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...r, x ])))

// beta reduce outermost r
(r => aux1 ({ recur, values: [ 1 ]  }, x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...r, x ]))) ([])

// =>
aux1
  ( { recur, values: [ 1 ]  }
  , x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])
  )

// =>
aux
  ( [ 1 ]
  , values => aux1 (f (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))
  )

// =>
[ 1 ]
.reduce
  ( (mr, e) =>
      k => mr (r => aux1 (e, x => k ([ ...r, x ])))
  , k => k ([])
  )
(values => aux1 (f (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ]))))

// beta reduce outermost k
(k => (k => k ([])) (r => aux1 (1, x => k ([ ...r, x ])))) (values => aux1 (f (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ]))))

// beta reduce outermost k
(k => k ([])) (r => aux1 (1, x => (values => aux1 (f (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ])))

// beta reduce outermost r
(r => aux1 (1, x => (values => aux1 (f (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([])

// =>
aux1
  ( 1
  , x => (values => aux1 (f (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...[], x ])
  )

// beta reduce outermost x
(x => (values => aux1 (f (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...[], x ])) (1)

// =>
(values => aux1 (f (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...[], 1 ])

// =>
(values => aux1 (f (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ 1 ])

// =>
aux1
  ( f (...[ 1 ])
  , x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])
  )

// =>
aux1
  ( f (1)
  , x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])
  )

// =>
aux1
  ( call (add, recur (2), 'b')
  , x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])
  )

// =>
aux1
  ( { call
    , f: add
    , values:
        [ { recur, values: [ 2 ] }
        , 'b'
        ]
    }
  , x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])
  )

// =>
aux
  ( [ { recur, values: [ 2 ] }
    , 'b'
    ]
  , values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))
  )

// =>
[ { recur, values: [ 2 ] }
, 'b'
]
.reduce
  ( (mr, e) =>
      k => mr (r => aux1 (e, x => k ([ ...r, x ])))
  , k => k ([])
  )
(values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ]))))

// beta reduce outermost k
(k => (k => (k => k ([])) (r => aux1 ({ recur, values: [ 2 ] }, x => k ([ ...r, x ])))) (r => aux1 ('b', x => k ([ ...r, x ])))) (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ]))))

// beta reduce outermost k
(k => (k => k ([])) (r => aux1 ({ recur, values: [ 2 ] }, x => k ([ ...r, x ])))) (r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ])))

// beta reduce outermost k
(k => k ([])) (r => aux1 ({ recur, values: [ 2 ] }, x => (r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ ...r, x ])))

// beta reduce outermost r
(r => aux1 ({ recur, values: [ 2 ] }, x => (r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ ...r, x ]))) ([])

// =>
aux1
  ( { recur, values: [ 2 ] }
  , x => (r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ ...[], x ])
  )

// =>
aux
  ( [ 2 ]
  , values => aux1 (f (...values), (x => (r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ ...[], x ])))
  )

// =>
[ 2 ]
.reduce
  ( (mr, e) =>
      k => mr (r => aux1 (e, x => k ([ ...r, x ])))
  , k => k ([])
  )
(values => aux1 (f (...values), (x => (r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ ...[], x ]))))

// beta reduce outermost k
(k => (k => k ([])) (r => aux1 (2, x => k ([ ...r, x ])))) (values => aux1 (f (...values), (x => (r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ ...[], x ]))))

// beta reduce outermost k
(k => k ([])) (r => aux1 (2, x => (values => aux1 (f (...values), (x => (r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ])))

// beta reduce outermost r
(r => aux1 (2, x => (values => aux1 (f (...values), (x => (r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([])

// =>
aux1
  ( 2
  , x => (values => aux1 (f (...values), (x => (r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...[], x ])
  )

// beta reduce outermost x
(x => (values => aux1 (f (...values), (x => (r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...[], x ])) (2)

// spread []
(values => aux1 (f (...values), (x => (r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...[], 2 ])

// beta reduce outermost values
(values => aux1 (f (...values), (x => (r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ ...[], x ])))) ([ 2 ])

// spread [ 2 ]
aux1
  ( f (...[ 2 ])
  , x => (r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ ...[], x ])
  )

// =>
aux1
  ( f (2)
  , x => (r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ ...[], x ])
  )

// =>
aux1
  ( 'z'
  , x => (r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ ...[], x ])
  )

// beta reduce outermost x
(x => (r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ ...[], x ])) ('z')

// spread []
(r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ ...[], 'z' ])

// beta reduce outermost r
(r => aux1 ('b', x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...r, x ]))) ([ 'z' ])

// =>
aux1
  ( 'b'
  , x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...[ 'z' ], x ])
  )

// beta reduce outermost x
(x => (values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...[ 'z' ], x ])) ('b')

// spread ['z']
(values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ ...[ 'z' ], 'b' ])

// beta reduce outermost values
(values => aux1 (add (...values), (x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])))) ([ 'z', 'b' ])

// =>
aux1
  ( add (...[ 'z', 'b' ])
  , x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])
  )

// =>
aux1
  ( add ('z', 'b')
  , x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])
  )

// =>
aux1
  ( 'zb'
  , x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])
  )

// beta reduce outermost x
(x => (r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], x ])) ('zb')

// spead []
(r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ ...[], 'zb' ])

// beta reduce outermost r
(r => aux1 ('a', x => (values => aux1 (add (...values), identity)) ([ ...r, x ]))) ([ 'zb' ])

// =>
aux1
  ( 'a'
  , x => (values => aux1 (f (...values), identity)) ([ ...[ 'zb' ], x ])
  )

// beta reduce outermost x
(x => (values => aux1 (f (...values), identity)) ([ ...[ 'zb' ], x ])) ('a')

// spead ['zb']
(values => aux1 (f (...values), identity)) ([ ...[ 'zb' ], 'a' ])

// beta reduce values
(values => aux1 (f (...values), identity)) ([ 'zb', 'a' ])

// spread [ 'zb', 'a' ]
aux1
  ( f (...[ 'zb', 'a' ])
  , identity
  )

// =>
aux1
  ( f ('zb', 'a')
  , identity
  )

// =>
aux1
  ( 'zba'
  , identity
  )

// =>
identity ('zba')

// =>
'zba'

Closures sure are amazing. Above we can confirm that CPS keeps the computation flat: we see either aux, aux1, or a simple beta reduction in each step. This is what makes it possible for us to put loop on a trampoline.

And this is where we double-dip on call. We use call to create an object for our looping computations, but aux and aux1 also spit out calls that are handled by run. I could've (maybe should've) made a different tag for this, but call was sufficiently generic that I could use it in both places.

So above where we see aux (...) and aux1 (...) and beta reductions (x => ...) (...), we simply replace them with call (aux, ...), call (aux1, ...) and call (x => ..., ...) respectively. Pass these to run and that's it — Stack-safe recursion in any shape or form. Simple as that 😅

---

tuning & optimisation

We can see that loop, although a small program, is doing a tremendous amount of work to keep your mind free from stack worries. We can also see where loop is not the most efficient; in particular with the sheer amount of rest parameters and spread arguments (...) we noticed. These are costly and if we can write loop without them, we can expect to see a big memory and speed improvement –

// loop : (unit -> 'a expr) -> 'a
const loop = f =>
{ // aux1 : ('a expr, 'a -> 'b) -> 'b
  const aux1 = (expr = {}, k = identity) =>
  { switch (expr.type)
    { case recur:
        // rely on aux to do its magic
        return call (aux, f, expr.values, k)
      case call:
        // rely on aux to do its magic
        return call (aux, expr.f, expr.values, k)
      default:
        return call (k, expr)
    }
  }

  // aux : (* -> 'a, (* expr) array, 'a -> 'b) -> 'b
  const aux = (f, exprs = [], k) =>
  { switch (exprs.length)
    { case 0: // nullary continuation
        return call (aux1, f (), k) 
      case 1: // unary
        return call
          ( aux1
          , exprs[0]
          , x => call (aux1, f (x), k) 
          )
      case 2: // binary
        return call
          ( aux1
          , exprs[0]
          , x =>
            call
              ( aux1
              , exprs[1]
              , y => call (aux1, f (x, y), k) 
              )
          )
      case 3: // ternary ...
      case 4: // quaternary ...
      default: // variadic
        return call
          ( exprs.reduce
              ( (mr, e) =>
                  k => call (mr, r => call (aux1, e, x => call (k, [ ...r, x ])))
              , k => call (k, [])
              )
          , values => call (aux1, f (...values), k)
          )
    }
  }

  return run (aux1 (f ()))
}

So now we only resort to rest/spread (...) when the user writes a loop or continuation that has more than four (4) parameters. This means that we can avoid the highly expensive variadiac lift using .reduce in the most common cases. I also noticed that switch offers a speed improvement (O(1), would be my assumption) compared to chained ternary ?: expressions, O(n).

This makes the definition of loop a bit bigger, but this trade-off is more than worth it. A preliminary measurement shows improvement of over 100% speed increase and over 50% less memory –

// before
fib(30)      // 5542.26 ms (25.7 MB)
foldr(20000) //  104.96 ms (31.07 MB)

// after
fib(30)      // 2472.58 ms (16.29 MB)
foldr(20000) //   45.33 ms (12.19 MB)

Of course there are many more ways in which loop could optimised, but the point of this exercise isn't to show you all of them. loop is a well-defined, pure function that gives you the comfort and freedom to make refactors as they're necessary.

PART 3 added: increasing loop's capabilities

Brown

Extending the fundamental boundaries of a language with the means of this very language - I didn't think it was possible, I will spend the time it deserves with your answer in the next few days. Thank you! – Slang

You're very welcome! Honestly I felt pretty good when I saw it all working. I fixed a little bug I had in aux that called continuations with arguments in wrong order (changed [ x, ...r ] to [ ...r, x ]). And I noticed foldr could be simplified from call (r => f (r, xs[i]), recur (i + 1)) to call (f, recur (i + 1), xs[i]) - which is a big improvement, imo. – Brown

I never could imagine how languages like Racket could promise stack-safe recursion for programs that didn't recur in tail position. Now I can say I finally understand how such a thing is possible! – Brown

Answer 3

hidden powers (part 3)

In our last answer, we made it possible to write foldr using natural expression and the computation remained stack-safe even though the recursive call is not in tail position -

// foldr : (('b, 'a) -> 'b, 'b, 'a array) -> 'b
const foldr = (f, init, xs = []) =>
  loop
    ( (i = 0) =>
        i >= xs.length
          ? init
          : call (f, recur (i + 1), xs[i])
    )

This is made possible because loop is effectively an evaluator for the call and recur expressions. But something surprising happened over the last day. It dawned on me that loop has a lot more potential just beneath the surface...

---

first-class continuations

Stack-safe loop is made possible by use of continuation-passing style and I realised that we can reify the continuation and make it available to the loop user: you -

// shift : ('a expr -> 'b expr) -> 'b expr
const shift = (f = identity) =>
  ({ type: shift, f })

// reset : 'a expr -> 'a
const reset = (expr = {}) =>
  loop (() => expr)

const loop = f =>
{ const aux1 = (expr = {}, k = identity) =>
  { switch (expr.type)
    { case recur: // ...
      case call: // ...

      case shift:
        return call
          ( aux1
          , expr.f (x => run (aux1 (x, k)))
          , identity
          )

      default: // ...
    }
  }

  const aux = // ...

  return run (aux1 (f ()))
}

---

examples

In this first example we capture the continuation add(3, ...) (or 3 + ?) in k -

reset
  ( call
      ( add
      , 3
      , shift (k => k (k (1)))
      )
  )

// => 7

We call apply k to 1 and then apply its result to k again -

//        k(?)  = (3 + ?)
//    k (k (?)) = (3 + (3 + ?))
//          ?   = 1
// -------------------------------
// (3 + (3 + 1))
// (3 + 4)
// => 7

The captured continuation can be arbitrarily deep in an expression. Here we capture the continuation (1 + 10 * ?) -

reset
  ( call
      ( add
      , 1
      , call
          ( mult
          , 10
          , shift (k => k (k (k (1))))
          )
      )
  )

// => 1111

Here we'll apply the continuation k three (3) times to an input of 1 -

//       k (?)   =                     (1 + 10 * ?)
//    k (k (?))  =           (1 + 10 * (1 + 10 * ?))
// k (k (k (?))) = (1 + 10 * (1 + 10 * (1 + 10 * ?)))
//          ?    = 1
// ----------------------------------------------------
// (1 + 10 * (1 + 10 * (1 + 10 * 1)))
// (1 + 10 * (1 + 10 * (1 + 10)))
// (1 + 10 * (1 + 10 * 11))
// (1 + 10 * (1 + 110))
// (1 + 10 * 111)
// (1 + 1110)
// => 1111

So far we've been capturing a continuation, k, and then applying it, k (...). Now watch what happens when we use k in a different way -

// r : ?
const r =
  loop
    ( (x = 10) =>
        shift (k => ({ value: x, next: () => k (recur (x + 1))}))
    )

r
// => { value: 10, next: [Function] }

r.next()
// => { value: 11, next: [Function] }

r.next()
// => { value: 11, next: [Function] }

r.next().next()
// => { value: 12, next: [Function] }

A wild stateless iterator appeared! Things are starting to get interesting...

---

harvest and yield

JavaScript generators allow us to produce a lazy stream of values using yield keyword expressions. However when a JS generator is advanced, it is permanently modified -

const gen = function* ()
{ yield 1
  yield 2
  yield 3
}

const iter = gen ()

console.log(Array.from(iter))
// [ 1, 2, 3 ]

console.log(Array.from(iter))
// [] // <-- iter already exhausted!

iter is impure and produces a different output for Array.from each time. This means that JS iterators cannot be shared. If you want to use the iterator in more than one place, you must recompute gen entirely each time -

console.log(Array.from(gen()))
// [ 1, 2, 3 ]

console.log(Array.from(gen()))
// [ 1, 2, 3 ]

As we saw with the shift examples, we can re-use the same continuation many times or save it and call it at a later time. We can effectively implement our own yield but without these pesky limitations. We'll call it stream below -

// emptyStream : 'a stream
const emptyStream =
  { value: undefined, next: undefined }

// stream : ('a, 'a expr) -> 'a stream
const stream = (value, next) =>
  shift (k => ({ value, next: () => k (next) }))

So now we can write our own lazy streams like -

// numbers : number -> number stream
const numbers = (start = 0) =>
  loop
    ( (n = start) =>
        stream (n, recur (n + 1))
    )

// iter : number stream
const iter =
  numbers (10)

iter
// => { value: 10, next: [Function] }

iter.next()
// => { value: 11, next: [Function] }

iter.next().next()
// => { value: 12, next: [Function] }

---

higher-order stream functions

stream constructs an iterator where value is the current value and next is a function that produce the next value. We can write higher-order functions like filter which take a filtering function, f, and an input iterator, iter, and produce a new lazy stream -

// filter : ('a -> boolean, 'a stream) -> 'a stream
const filter = (f = identity, iter = {}) =>
  loop
    ( ({ value, next } = iter) =>
        next
          ? f (value)
            ? stream (value, recur (next ()))
            : recur (next ())
          : emptyStream
    )

const odds =
  filter (x => x & 1 , numbers (1))

odds
// { value: 1, next: [Function] }

odds.next()
// { value: 3, next: [Function] }

odds.next().next()
// { value: 5, next: [Function] }

We'll write take to limit the infinite stream to 20,000 elements and then convert the stream to an array using toArray -

// take : (number, 'a stream) -> 'a stream
const take = (n = 0, iter = {}) =>
  loop
    ( ( m = n
      , { value, next } = iter
      ) =>
        m && next
          ? stream (value, recur (m - 1, next ()))
          : emptyStream
    )

// toArray : 'a stream -> 'a array
const toArray = (iter = {}) =>
  loop
    ( ( r = []
      , { value, next } = iter
      ) =>
        next
          ? recur (push (r, value), next ())
          : r
    )

toArray (take (20000, odds))
// => [ 1, 3, 5, 7, ..., 39999 ]

This is just a start. There are many other stream operations and optimisations we could make to enhance usability and performance.

---

higher-order continuations

With first-class continuations available to us, we can easily make new and interesting kinds of computation possible. Here's a famous "ambiguous" operator, amb, for representing non-deterministic computations -

// amb : ('a array) -> ('a array) expr
const amb = (xs = []) =>
  shift (k => xs .flatMap (x => k (x)))

Intuitively, amb allows you to evaluate an ambiguous expression – one that may return no results, [], or one that returns many, [ ... ] -

// pythag : (number, number, number) -> boolean
const pythag = (a, b, c) =>
  a ** 2 + b ** 2 === c ** 2

// solver : number array -> (number array) array
const solver = (guesses = []) =>
  reset
    ( call
        ( (a, b, c) =>
            pythag (a, b, c) 
              ? [ [ a, b, c ] ] // <-- possible result
              : []              // <-- no result
        , amb (guesses)
        , amb (guesses)
        , amb (guesses)
      )
    )

solver ([ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ])
// => [ [ 3, 4, 5 ], [ 4, 3, 5 ], [ 6, 8, 10 ], [ 8, 6, 10 ] ]

And amb is used again here to write product -

// product : (* 'a array) -> ('a array) array
const product = (...arrs) =>
  loop
    ( ( r = []
      , i = 0
      ) =>
        i >= arrs.length
          ? [ r ]
          : call
              ( x => recur ([ ...r, x ], i + 1)
              , amb (arrs [i])
              )
    )


product([ 0, 1 ], [ 0, 1 ], [ 0, 1 ])
// [ [0,0,0], [0,0,1], [0,1,0], [0,1,1], [1,0,0], [1,0,1], [1,1,0], [1,1,1] ]

product([ 'J', 'Q', 'K', 'A' ], [ '♡', '♢', '♤', '♧' ])
// [ [ J, ♡ ], [ J, ♢ ], [ J, ♤ ], [ J, ♧ ]
// , [ Q, ♡ ], [ Q, ♢ ], [ Q, ♤ ], [ Q, ♧ ]
// , [ K, ♡ ], [ K, ♢ ], [ K, ♤ ], [ K, ♧ ]
// , [ A, ♡ ], [ A, ♢ ], [ A, ♤ ], [ A, ♧ ]
// ]

---

full circle

To keep this answer relevant to the post, we'll rewrite foldr using first-class continuations. Of course no one would write foldr like this, but we want to demonstrate that our continuations are robust and complete -

// 
const foldr = (f, init, xs = []) =>
  loop
    ( ( i = 0
      , r = identity
      ) =>
        i >= xs.length
          ? r (init)
          : call
              ( f
              , shift (k => recur (i + 1, comp (r, k)))
              , xs[i]
              )
    )

foldr (add, "z", "abcefghij")
// => "zjihgfedcba"


foldr (add, "z", "abcefghij".repeat(2000))
// => RangeError: Maximum call stack size exceeded

This is precisely the "deferred overflow" we talked about in the first answer. But since we have full control of the continuations here, we can chain them in a safe way. Simply replace comp above with compExpr and everything works as intended -

// compExpr : ('b expr -> 'c expr, 'a expr -> 'b expr) -> 'a expr -> 'c expr
const compExpr = (f, g) =>
  x => call (f, call (g, x))

foldr (add, "z", "abcefghij".repeat(2000))
// => "zjihgfecbajihgfecbajihgf....edcba"

---

code demonstration

Expand the snippet below to verify the results in your own browser -

// identity : 'a -> 'a
const identity = x =>
  x

// call : (* -> 'a expr, *) -> 'a expr
const call = (f, ...values) =>
  ({ type: call, f, values })

// recur : * -> 'a expr
const recur = (...values) =>
  ({ type: recur, values })

// shift : ('a expr -> 'b expr) -> 'b expr
const shift = (f = identity) =>
  ({ type: shift, f })

// reset : 'a expr -> 'a
const reset = (expr = {}) =>
  loop (() => expr)

// amb : ('a array) -> ('a array) expr
const amb = (xs = []) =>
  shift (k => xs .flatMap (x => k (x)))

// add : (number, number) -> number
const add = (x = 0, y = 0) =>
  x + y

// mult : (number, number) -> number
const mult = (x = 0, y = 0) =>
  x * y

// loop : (unit -> 'a expr) -> 'a
const loop = f =>
{ // aux1 : ('a expr, 'a -> 'b) -> 'b
  const aux1 = (expr = {}, k = identity) =>
  { switch (expr.type)
    { case recur:
        return call (aux, f, expr.values, k)
      case call:
        return call (aux, expr.f, expr.values, k)
      case shift:
          return call
            ( aux1
            , expr.f (x => run (aux1 (x, k)))
            , identity
            )
      default:
        return call (k, expr)
    }
  }

  // aux : (* -> 'a, (* expr) array, 'a -> 'b) -> 'b
  const aux = (f, exprs = [], k) =>
  { switch (exprs.length)
    { case 0:
        return call (aux1, f (), k) // nullary continuation
      case 1:
        return call
          ( aux1
          , exprs[0]
          , x => call (aux1, f (x), k) // unary
          )
      case 2:
        return call
          ( aux1
          , exprs[0]
          , x =>
            call
              ( aux1
              , exprs[1]
              , y => call (aux1, f (x, y), k) // binary
              )
          )
      case 3: // ternary ...
      case 4: // quaternary ...
      default: // variadic
        return call
          ( exprs.reduce
              ( (mr, e) =>
                  k => call (mr, r => call (aux1, e, x => call (k, [ ...r, x ])))
              , k => call (k, [])
              )
          , values => call (aux1, f (...values), k)
          )
    }
  }

  return run (aux1 (f ()))
}

// run : * -> *
const run = r =>
{ while (r && r.type === call)
    r = r.f (...r.values)
  return r
}

// example1 : number
const example1 =
  reset
    ( call
        ( add
        , 3
        , shift (k => k (k (1)))
        )
    )

// example2 : number
const example2 =
  reset
    ( call
        ( add
        , 1
        , call
            ( mult
            , 10
            , shift (k => k (k (1)))
            )
        )
    )

// emptyStream : 'a stream
const emptyStream =
  { value: undefined, next: undefined }

// stream : ('a, 'a expr) -> 'a stream
const stream = (value, next) =>
  shift (k => ({ value, next: () => k (next) }))

// numbers : number -> number stream
const numbers = (start = 0) =>
  loop
    ( (n = start) =>
        stream (n, recur (n + 1))
    )

// filter : ('a -> boolean, 'a stream) -> 'a stream
const filter = (f = identity, iter = {}) =>
  loop
    ( ({ value, next } = iter) =>
        next
          ? f (value)
            ? stream (value, recur (next ()))
            : recur (next ())
          : emptyStream
    )

// odds : number stream
const odds =
  filter (x => x & 1 , numbers (1))

// take : (number, 'a stream) -> 'a stream
const take = (n = 0, iter = {}) =>
  loop
    ( ( m = n
      , { value, next } = iter
      ) =>
        m && next
          ? stream (value, recur (m - 1, next ()))
          : emptyStream
    )

// toArray : 'a stream -> 'a array
const toArray = (iter = {}) =>
  loop
    ( ( r = []
      , { value, next } = iter
      ) =>
        next
          ? recur ([ ...r, value ], next ())
          : r
    )

// push : ('a array, 'a) -> 'a array
const push = (a = [], x = null) =>
  ( a .push (x)
  , a
  )

// pythag : (number, number, number) -> boolean
const pythag = (a, b, c) =>
  a ** 2 + b ** 2 === c ** 2

// solver : number array -> (number array) array
const solver = (guesses = []) =>
  reset
    ( call
        ( (a, b, c) =>
            pythag (a, b, c)
              ? [ [ a, b, c ] ] // <-- possible result
              : []              // <-- no result
        , amb (guesses)
        , amb (guesses)
        , amb (guesses)
      )
    )

// product : (* 'a array) -> ('a array) array
const product = (...arrs) =>
  loop
    ( ( r = []
      , i = 0
      ) =>
        i >= arrs.length
          ? [ r ]
          : call
              ( x => recur ([ ...r, x ], i + 1)
              , amb (arrs [i])
              )
    )

// foldr : (('b, 'a) -> 'b, 'b, 'a array) -> 'b
const foldr = (f, init, xs = []) =>
  loop
    ( ( i = 0
      , r = identity
      ) =>
        i >= xs.length
          ? r (init)
          : call
              ( f
              , shift (k => recur (i + 1, compExpr (r, k)))
              , xs[i]
              )
    )

// compExpr : ('b expr -> 'c expr, 'a expr -> 'b expr) -> 'a expr -> 'c expr
const compExpr = (f, g) =>
  x => call (f, call (g, x))

// large : number array
const large =
  Array .from (Array (2e4), (_, n) => n + 1)

// log : (string, 'a) -> unit
const log = (label, x) =>
  console.log(label, JSON.stringify(x))

log("example1:", example1)
// 7

log("example2:", example2)
// 1111

log("odds", JSON.stringify (toArray (take (100, odds))))
// => [ 1, 3, 5, 7, ..., 39999 ]

log("solver:", solver ([ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ]))
// => [ [ 3, 4, 5 ], [ 4, 3, 5 ], [ 6, 8, 10 ], [ 8, 6, 10 ] ]

log("product:", product([ 0, 1 ], [ 0, 1 ], [ 0, 1 ]))
// [ [0,0,0], [0,0,1], [0,1,0], [0,1,1], [1,0,0], [1,0,1], [1,1,0], [1,1,1] ]

log("product:", product([ 'J', 'Q', 'K', 'A' ], [ '♡', '♢', '♤', '♧' ]))
// [ [ J, ♡ ], [ J, ♢ ], [ J, ♤ ], [ J, ♧ ]
// , [ Q, ♡ ], [ Q, ♢ ], [ Q, ♤ ], [ Q, ♧ ]
// , [ K, ♡ ], [ K, ♢ ], [ K, ♤ ], [ K, ♧ ]
// , [ A, ♡ ], [ A, ♢ ], [ A, ♤ ], [ A, ♧ ]
// ]

log("foldr:", foldr (add, "z", "abcefghij".repeat(2000)))
// "zjihgfecbajihgfecbajihgf....edcba"

remarks

This was my first time implementing first-class continuations in any language and it was a truly eye-opening experience I wanted to share with others. We got all of this for adding two simple functions shift and reset -

// shift : ('a expr -> 'b expr) -> 'b expr
const shift = (f = identity) =>
  ({ type: shift, f })

// reset : 'a expr -> 'a
const reset = (expr = {}) =>
  loop (() => expr)

And adding the corresponding pattern-match in our loop evaluator -

// ...
case shift:
  return call
    ( aux1
    , expr.f (x => run (aux1 (x, k)))
    , identity
    )

Between stream and amb alone, this is an enormous amount of potential. It makes me wonder just how fast we could make loop such that we could use this in a practical setting.

Brown

I really need to catch up on this. I got quite some experience in making some of your ideas production ready. We'll see... – Slang