如何使蹦床适应延续传球风格？

Question

这是一个简单的右折叠实现：

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

这是非尾递归，因此我们不能应用蹦床。一种方法是使算法迭代并使用堆栈来模仿函数调用堆栈。

另一种方法是将递归转换为 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_))));

这仍然很幼稚，因为它非常慢。这是一个内存消耗较少的版本：

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

递归调用现在处于尾部位置，因此我们应该能够应用我们选择的蹦床：

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

这不起作用，因为蹦床调用在延续内部，因此被延迟评估。蹦床必须如何适应才能与 CPS 一起使用？

Answer 1

尾调用先（第 1 部分）

首先编写循环，使其在尾部位置重复

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

给定两个输入，small 和 large，我们测试 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

但是它使用了蹦床，为什么large会失败？简短的回答是因为我们构建了一个巨大的延迟计算，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
        )
  )

在终止条件下，我们最终调用k(init) 触发延迟计算堆栈，20,000 次函数调用深度，触发堆栈溢出。

在继续阅读之前，请展开下面的 sn-p 以确保我们在同一页面上 -

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

---

延迟溢出

我们在这里看到的问题与您在使用 compose(...) 或 pipe(...) 20,000 个函数时可能遇到的问题相同 -

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

或类似使用comp -

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

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

当然，foldl 是堆栈安全的，它可以组合 20,000 个函数，但是一旦你调用这个庞大的组合，你就有炸毁堆栈的风险。现在将其与 -

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

... 它不会破坏堆栈，因为计算不会延迟。相反，一个步骤的结果会覆盖上一步的结果，直到到达最后一步。

其实我们写的时候——

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

另一种查看方式是 -

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

这应该准确地突出问题所在。

---

可能的解决方案

一个简单的补救措施是添加一个单独的call 标记，以使蹦床中的延迟计算变平。所以我们不会像f (x)那样直接调用函数，而是写成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]))
              )
   )

我们修改蹦床以作用于call-tagged 值 -

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
}

最后，我们看到large 输入不再溢出堆栈-

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，你建立了自己的评估器

在上面，recur 和 call 似乎是魔术函数。但实际上，recur 和 call 创建简单对象 { ... } 和 loop 正在完成所有工作。这样，loop 是一种接受recur 和call 表达式 的求值器。此解决方案的一个缺点是我们希望调用者始终在尾部位置使用recur 或call，否则循环将返回不正确的结果。

这与将递归机制具体化为参数的Y-combinator不同，并且不限于仅尾部位置，例如recur这里-

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

Y 的一个缺点当然是，因为您通过调用函数来控制递归，所以就像 JS 中的所有其他函数一样，您仍然是堆栈不安全的。结果是堆栈溢出 -

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

那么是否有可能在非尾部位置支持recur 并且保持堆栈安全？当然，足够聪明的loop 应该能够评估递归表达式 -

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 成为 CPS 尾递归函数，用于评估输入表达式 call、recur 等。然后我们将 loop 放在蹦床上。 loop 有效地成为我们自定义语言的评估者。现在您可以忘记堆栈的所有内容了——您现在唯一的限制是内存！

或者-

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

在这个related Q&A 中，我为 JavaScript 中的无类型 lambda 演算编写了一个正阶求值器。它展示了如何编写不受宿主语言的实现影响（评估策略、堆栈模型等）的程序。那里我们使用的是 Church-encoding，这里使用的是 call 和 recur，但技术是一样的。

几年前，我使用上面描述的技术编写了一个堆栈安全的变体。我会看看我是否可以复活它，然后在这个答案中提供它。现在，我将把 loop 评估器作为练习留给读者。

第 2 部分已添加： loop evaluator

---

替代解决方案

在这个related Q&A 中，我们构建了一个堆栈安全的延续单子。

Answer 2

是的，是的，是的（第 2 部分）

所以我相信这个答案更接近您问题的核心 - 我们可以让 any 递归程序堆栈安全吗？即使递归不在尾部位置？即使宿主语言没有尾调用消除？是的。是的。是的 - 有一个小要求......

我的第一个答案的结尾谈到了loop 作为一种评估者，然后描述了如何实现它的粗略想法。理论听起来不错，但我想确保该技术在实践中有效。所以我们开始吧！

---

非平凡的程序

斐波那契非常适合这一点。二元递归实现构建了一个大递归树，并且递归调用都不在尾部位置。如果我们能正确地完成这个程序，我们就有理由相信我们正确地实现了loop。

还有一个小要求：你不能调用一个函数来递归。而不是f (x)，你会写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

但是这些call 和recur 函数并没有什么特别之处。他们只创建普通的 JS 对象——

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

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

所以在这个程序中，我们有一个依赖于两个recurs 的call。每个recur 都有可能产生另一个call 和额外的recurs。确实是一个不平凡的问题，但实际上我们只是在处理一个定义良好的递归数据结构。

---

写作loop

如果loop 要处理这个递归数据结构，如果我们可以将loop 编写为递归程序，那将是最简单的。但是我们不是会在其他地方遇到堆栈溢出吗？一起来了解一下吧！

// 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 ())
}

所以loop 需要一个函数来循环，f。我们期望 f 在计算完成后返回一个普通的 JS 值。否则返回 call 或 recur 以增加计算量。

这些 todos 填写起来有些琐碎。让我们现在就这样做——

// 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 ())
}

所以直观地说，aux1（“辅助一”）是我们挥动 one 表达式 expr 的魔杖，result 继续出现。换句话说——

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

要评估recur 或call，我们必须首先评估相应的values。我们希望我们能写出类似的东西——

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

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

... 的延续会是什么？我们不能像这样在.map 中调用aux1。相反，我们需要另一个可以接受表达式数组并将结果值传递给它的延续的魔杖；比如aux——

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

---

肉和土豆

好的，这可能是问题中最棘手的部分。对于输入数组中的每个表达式，我们必须调用 aux1 并将延续链接到下一个表达式，最后将值传递给用户提供的延续 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)

我们最终不会使用它，但它有助于了解我们在 aux 中所做的事情，以普通的 reduce 和 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 ([])
    )

把它们放在一起，我们得到了——

// 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 (10)
// => 55

但只有一点——

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

---

你原来的问题

在我们尝试修复 loop 之前，让我们重新审视一下您的问题中的程序 foldr，看看它是如何使用 loop、call 和 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])
    )

它是如何工作的？

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

好的，它可以工作，但对于 small，但它会炸毁 large 的堆栈。但这正是我们所期望的，对吧？毕竟，loop 只是一个普通的递归函数，必然会发生堆栈溢出……对吧？

在我们继续之前，请在您自己的浏览器中验证目前的结果——

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

---

弹跳循环

我有太多关于将函数转换为 CPS 并使用蹦床弹跳它们的答案。这个答案不会关注那么多。上面我们有 aux1 和 aux 作为 CPS 尾递归函数。下面的转换可以通过机械的方式完成。

就像我们在另一个答案中所做的那样，对于我们找到的每个函数调用 f (x)，将其转换为 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 ()))
}

将return 包裹在run 中，这是一个简化的蹦床——

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

它现在如何运作？

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

通过展开并运行下面的 sn-p，在 任何 JavaScript 程序中见证堆栈安全递归 -

// 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!

---

评估可视化

让我们使用foldr 评估一个简单的表达式，看看我们是否可以窥探loop 是如何发挥它的魔力的——

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

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

您可以通过将其粘贴到支持括号突出显示的文本编辑器中来跟进 -

// =>
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'

闭包确实很棒。上面我们可以确认 CPS 使计算保持平坦：我们看到aux、aux1，或者在每个步骤中进行简单的 beta 缩减。这就是我们可以将loop 放在蹦床上的原因。

这就是我们在call 上双标的地方。我们使用call 为我们的looping 计算创建一个对象，但aux 和aux1 也输出由run 处理的calls。我本可以（也许应该）为此制作一个不同的标签，但call 足够通用，我可以在这两个地方使用它。

因此，在上面我们看到aux (...) 和aux1 (...) 以及beta 减少(x => ...) (...) 的地方，我们只需将它们分别替换为call (aux, ...)、call (aux1, ...) 和call (x => ..., ...)。将这些传递给run，就是这样——任何形状或形式的堆栈安全递归。就这么简单?

---

调整和优化

我们可以看到，loop 虽然是一个小程序，但正在做大量的工作来让你的大脑摆脱堆栈的烦恼。我们还可以看到loop 不是最有效的地方；特别是我们注意到大量的剩余参数和扩展参数（...）。这些都是昂贵的，如果我们可以在没有它们的情况下编写loop，我们可以期待看到很大的内存和速度提升——

// 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 ()))
}

所以现在我们只在用户编写具有四 (4) 个以上参数的循环或延续时才使用休息/扩展 (...)。这意味着我们可以在最常见的情况下避免使用.reduce 来避免非常昂贵的变调器升​​降机。我还注意到，与链式三元 ?: 表达式 O(n) 相比，switch 提供了速度改进（O(1)，这是我的假设）。

这使得loop 的定义有点大，但这种权衡是值得的。初步测量显示速度提高了 100% 以上，内存减少了 50% 以上 -

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

当然，loop 可以优化的方式还有很多，但本练习的重点并不是向您展示所有这些方式。 loop 是一个定义明确的纯函数，可让您在必要时轻松自如地进行重构。

添加第 3 部分：increasing loop's capabilities

Answer 3

隐藏的力量（第 3 部分）

在我们的最后一个答案中，我们可以使用自然表达式编写foldr，即使递归调用不在尾部位置，计算仍然是堆栈安全的 -

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

这之所以成为可能，是因为loop 实际上是call 和recur 表达式的求值器。但是最后一天发生了一些令人惊讶的事情。我突然意识到loop 在表面之下还有更多的潜力......

---

一流的延续

堆栈安全的loop 是通过使用延续传递样式实现的，我意识到我们可以具体化延续并将其提供给loop 用户：你-

// 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 ()))
}

---

示例

在第一个示例中，我们捕获k 中的延续add(3, ...)（或3 + ?）-

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

// => 7

我们调用 apply k 到 1，然后再次将其结果应用到 k -

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

捕获的延续可以在表达式中任意深度。在这里我们捕获了延续(1 + 10 * ?) -

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

// => 1111

在这里，我们将对1 的输入应用延续k 三 (3) 次-

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

到目前为止，我们一直在捕获一个延续，k，然后应用它，k (...)。现在看看当我们以不同的方式使用 k 时会发生什么 -

// 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] }

一个狂野的无状态迭代器出现了！事情开始变得有趣了……

---

收获和收获

JavaScript 生成器允许我们使用 yield 关键字表达式生成惰性值流。但是，当 JS 生成器升级时，它会被永久修改 -

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 不纯，每次都会为Array.from 产生不同的输出。这意味着 JS 迭代器不能被共享。如果你想在多个地方使用迭代器，你必须每次都重新计算gen -

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

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

正如我们在shift 示例中看到的那样，我们可以多次重复使用相同的延续，或者保存它并在以后调用它。我们可以有效地实现我们自己的yield，但没有这些讨厌的限制。我们在下面称它为stream -

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

// 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] }

---

高阶流函数

stream 构造一个迭代器，其中value 是当前值，next 是产生下一个值的函数。我们可以编写像 filter 这样的高阶函数，它接受一个过滤函数 f 和一个输入迭代器 iter，并生成一个新的惰性流 -

// 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] }

我们将编写 take 以将无限流限制为 20,000 个元素，然后使用 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 ]

这只是一个开始。我们可以进行许多其他流操作和优化来提高可用性和性能。

---

高阶延续

我们可以使用一流的延续，我们可以轻松地使新的有趣类型的计算成为可能。这是一个著名的“模糊”运算符amb，用于表示非确定性计算 -

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

直观地说，amb 允许您评估一个模棱两可的表达式 - 一个可能不返回结果的表达式 []，或者一个返回多个结果的表达式 [ ... ] -

// 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 ] ]

这里又用amb写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, ♧ ]
// ]

---

整圈

为了使这个答案与帖子相关，我们将使用一流的延续重写foldr。当然没有人会这样写foldr，但我们想证明我们的延续是健壮和完整的 -

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

这正是我们在第一个答案中谈到的“延迟溢出”。但是由于我们在这里完全控制了延续，我们可以以安全的方式将它们链接起来。只需将上面的comp 替换为compExpr，一切都会按预期工作-

// 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"

---

代码演示

展开下面的sn-p，在自己的浏览器中验证结果-

// 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"

备注

这是我第一次用任何语言实现一流的延续，这是我想与他人分享的真正令人大开眼界的体验。我们通过添加两个简单的函数 shift 和 reset 得到了所有这些 -

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

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

并在我们的 loop 评估器中添加相应的模式匹配 -

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

仅在stream 和amb 之间，就有巨大的潜力。这让我想知道我们能以多快的速度制作loop，以便我们可以在实际环境中使用它。