CPS转换时如何避免堆栈溢出？

Question

我正在编写从 Scheme 子集到 CPS 语言的转换。它在 F# 中实现。在大输入程序中转换因堆栈溢出而失败。

我正在使用论文Compiling with Continuations 中描述的某种算法。 我尝试将工作线程的最大堆栈大小增加到 50 MB，然后就可以了。

也许有一些方法可以修改算法，这样我就不需要调整堆栈大小了？

例如算法变换

(foo (bar 1) (bar 2))

到

(let ((c1 (cont (r1)
           (let ((c2 (cont (r2)
                  (foo halt r1 r2))))
            (bar c2 2)))))
 (bar c1 1))

其中halt 是结束程序的最终延续。

Answer 1

也许您的实际问题有简单的解决方案来避免大量堆栈消耗，所以请不要介意添加细节。但是，如果没有更多关于您的特定代码的知识，这里有一个通用的方法来减少递归程序中的堆栈消耗，基于蹦床和延续。

沃克

这是一个典型的递归函数，不是普通的尾递归，因为我不懂 F#，所以用 Common Lisp 写的：

(defun walk (form transform join)
  (typecase form
    (cons (funcall join
                   (walk (car form) transform join)
                   (walk (cdr form) transform join)))
    (t (funcall transform form))))

不过，希望代码非常简单，并且会遍历由 cons 单元组成的树：

1. 如果表单是一个 cons-cell，递归地走上汽车（resp. cdr）并加入结果
2. 否则，对值应用变换

例如：

(walk '(a (b c d) 3 2 (a 2 1) 0)
      (lambda (u) (and (numberp u) u))
      (lambda (a b) (if a (cons a b) (or a b))))

=> (3 2 (2 1) 0)

代码遍历表单，只保留数字，但保留（非空）嵌套。

使用上述示例在walk 上调用trace 显示最大深度为8 个嵌套调用。

延续和蹦床

这是一个改编版本，叫做 walk/then，像以前一样走一个表格，当结果是 可用，请致电then。这里then 是延续。

该函数还返回一个thunk，即一个无参数闭包。 发生的情况是，当我们返回闭包时，堆栈被展开， 当我们应用 thunk 时，它会 从一个新的堆栈开始，但在计算方面取得了进步 （我通常想象有人走上下降的自动扶梯）。 我们返回一个 thunk 以减少堆栈帧的数量这一事实是 trampoline 的一部分。

then 函数接受一个值，即 当前 walk 最终将返回的结果。 结果因此被传递向下堆栈，什么是 每一步都返回一个 thunk 函数。

嵌套延续允许捕获transform/join 的复杂行为，方法是将计算的剩余部分推送到嵌套延续中。

(defun walk/then (form transform join then)
  (typecase form
    (cons (lambda ()
            (walk/then (car form) transform join
                       (lambda (v)
                         (walk/then (cdr form) transform join
                                    (lambda (w)
                                      (funcall then (funcall join v w))))))))
    (t (funcall then (funcall transform form)))))

例如，(walk/then (car form) transform join (lambda (v) ...)) 如下所示：walk the car of form with 参数transform 和join，并最终在结果上调用(lambda (v) ...)；即，沿着 cdr 走，然后加入两个结果；最终，在连接结果上调用输入then。

缺少的是一种不断调用返回的 thunk 直到耗尽的方法；就这个 带有循环，但这很容易成为尾递归函数：

(loop for res = 
     (walk/then '(a (b c d) 3 2 (a 2 1) 0)
                (lambda (u) (and (numberp u) u))
                (lambda (a b) (if a (cons a b) (or a b)))
                #'identity)
   then (typecase res (function (funcall res)) (t res))
   while (functionp res)
   finally (return res))

上面返回(3 2 (2 1) 0)，跟踪walk/then时，跟踪深度永远不会超过2。

请参阅Eli Bendersky's article 以了解有关 Python 的其他内容。

Answer 2

我已将算法转换为蹦床形式。它看起来像 FSM。 有一个循环，它查看当前状态，进行一些操作，然后进入另一个状态。它还使用两个堆栈来实现不同类型的延续。

这是输入语言（它是我最初使用的语言的子集）：

// Input language consists of only variables and function applications
type Expr =
    | Var of string
    | App of Expr * Expr list

这里是目标语言：

// CPS form - each function gets a continuation,
// added continuation definitions and continuation applications
type Norm =
    | LetCont of name : string * args : string list * body : Norm * inner : Norm
    | FuncCall of func : string * cont : string * args : string list
    | ContCall of cont : string * args : string list

这是原始算法：

// Usual way to make CPS conversion.
let rec transform expr cont =
    match expr with
    | App(func, args) ->
        transformMany (func :: args) (fun vars ->
            let func' = List.head vars
            let args' = List.tail vars
            let c = fresh()
            let r = fresh()
            LetCont(c, [r], cont r, FuncCall(func', c, args')))
    | Var(v) -> cont v

and transformMany exprs cont =
    match exprs with
    | e :: rest ->
        transform e (fun e' ->
            transformMany rest (fun rest' ->
                cont (e' :: rest')))
    | _ -> cont []

let transformTop expr =
    transform expr (fun var -> ContCall("halt", [var]))

这里是修改版：

type Action =
    | ContinuationVar of Expr * (string -> Action)
    | ContinuationExpr of string * (Norm -> Action)
    | TransformMany of string list * Expr list * (string list -> Action)
    | Result of Norm
    | Variable of string

// Make one action at time and return to top loop
let rec transform2 expr =
    match expr with
    | App(func, args) ->
        TransformMany([], func :: args, (fun vars ->
            let func' = List.head vars
            let args' = List.tail vars
            let c = fresh()
            let r = fresh()
            ContinuationExpr(r, fun expr ->
                Result(LetCont(c, [r], expr, FuncCall(func', c, args'))))))
    | Var(v) -> Variable(v)

// We have two stacks here:
// contsVar for continuations accepting variables
// contsExpr for continuations accepting expressions
let transformTop2 expr =
    let rec loop contsVar contsExpr action =
        match action with
        | ContinuationVar(expr, cont) ->
            loop (cont :: contsVar) contsExpr (transform2 expr)
        | ContinuationExpr(var, contExpr) ->
            let contVar = List.head contsVar
            let contsVar' = List.tail contsVar
            loop contsVar' (contExpr :: contsExpr) (contVar var)
        | TransformMany(vars, e :: exprs, cont) ->
            loop contsVar contsExpr (ContinuationVar(e, fun var ->
                TransformMany(var :: vars, exprs, cont)))
        | TransformMany(vars, [], cont) ->
            loop contsVar contsExpr (cont (List.rev vars))
        | Result(r) ->
            match contsExpr with
            | cont :: rest -> loop contsVar rest (cont r)
            | _ -> r
        | Variable(v) ->
            match contsVar with
            | cont :: rest -> loop rest contsExpr (cont v)
            | _ -> failwith "must not be empty"

    let initial = ContinuationVar(expr, fun var -> Result(ContCall("halt", [var])))
    loop [] [] initial