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

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

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

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

我的第一个答案的结尾谈到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 })

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

---

写作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增加计算。

这些待办事项填写起来有些微不足道。现在让我们这样做 -

// 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的魔杖，然后在延续中返回。换句话说 -exprresult

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

延续...会是什么？我们不能这样打电话aux1。.map相反，我们需要另一个可以接收表达式数组并将结果值传递给其延续的魔术棒；比如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...)

通过扩展和运行下面的代码片段来见证任何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吐出call由run. 我本可以（也许应该）为此制作一个不同的标签，但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) 个参数的循环或延续时才使用 rest/spread ( )。这意味着我们可以避免.reduce在最常见的情况下使用非常昂贵的变调升降机。我还注意到与switch链式O(1)三元?:表达式O(n).

这使得定义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 部分添加：增加循环的功能

Answer 2

先尾调用（第 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 次函数调用，这触发了堆栈溢出。

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

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是一种接受和表达式的求值器。该解决方案的一个缺点是我们希望调用者始终使用或处于尾部位置，否则循环将返回不正确的结果。recurcall recurcall

这与将递归机制具体化为参数的 Y 组合器不同，并且不限于仅尾部位置，例如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

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

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

第 2 部分添加： 循环评估器

---

替代解决方案

在这个相关的问答中，我们构建了一个堆栈安全的延续单子。

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

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

---

一流的延续

Stack-safeloop是通过使用 continuation-passing 风格实现的，我意识到我们可以具体化 continuation 并将其提供给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 ()))
}

---

例子

add(3, ...)在第一个示例中，我们捕获3 + ?了k-

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

// => 7

我们调用 apply kto1然后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

在这里，我们将连续k三 (3) 次应用于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

到目前为止，我们一直在捕获一个延续，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!

iterArray.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"

---

代码演示

展开下面的代码片段以在您自己的浏览器中验证结果 -

// 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在实际环境中使用它。