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

也许你的实际问题有简单的解决方案来避免大量的堆栈消耗，所以请不要介意添加细节。但是，在不了解您的特定代码的情况下，这里是一种基于蹦床和延续的减少递归程序堆栈消耗的通用方法。

沃克

这是一个典型的递归函数，不是平凡的尾递归，用 Common Lisp 编写，因为我不懂 F#:

(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 单元组成的树：

如果表格是cons-cell，递归走上车（resp.cdr）并加入结果
否则，对值应用转换

例如：

(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 是 continuation.

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

的一部分

then函数取一个值，即当前行走最终会return的结果。结果被向下压入栈中，什么是 return每一步都是一个 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

缺少的是一种不断调用 returned 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))

以上returns (3 2 (2 1) 0)，并且跟踪时跟踪深度不超过2walk/then。

请参阅 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

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

How to avoid stack overflow during CPS conversion?

lisp

compiler-construction

f#

沃克

延续和蹦床