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

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 次函数调用，触发堆栈溢出。

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

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

<小时 />

延迟溢出

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

// 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标记的值 -

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 组合器不同，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

在这个相关的问答中，我用 JavaScript 为无类型化 lambda 演算编写了一个正序求值器。它展示了如何编写不受宿主语言的实现效果(评估策略、堆栈模型等)影响的程序。在那里我们使用教会编码，这里使用call和recur，但技术是相同的。

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

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

<小时 />

替代解决方案

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

Answer 2

是、是和是(第 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 })

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

---

写作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("辅助的")是我们挥舞在一个表情上的魔杖，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))

延续...是什么？我们不能这样称呼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，要么是简单的β减少。这就是我们可以将loop放在蹦床上的原因。

这就是我们双浸的地方call.我们使用call为我们的loop计算创建一个对象，但aux和aux1也吐出run处理的call。我本可以(也许应该)为此制作一个不同的标签，但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进行非常昂贵的变频提升。我还注意到，与链式三元?:表达式相比，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 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

我们将应用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

在这里，我们将延续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!

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"

---

代码演示

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

// 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以便我们可以在实际环境中使用它。