Как избежать переполнения стека при конвертации CPS? - PullRequest
Новая
       13

Как избежать переполнения стека при конвертации CPS?

0 голосов
/ 16 октября 2019

Я пишу преобразование из подмножества Scheme в язык CPS. Это реализовано в F #. На больших входных программах преобразование завершается неудачно из-за переполнения стека.

Я использую какой-то алгоритм, описанный в статье Компиляция с продолжениями . Я попытался увеличить максимальный размер стека рабочего потока до 50 МБ, затем он работает.

Может быть, есть какой-то способ изменить алгоритм, чтобы мне не нужно было настраивать стекsize?

Например, алгоритм преобразует 

(foo (bar 1) (bar 2))

в 

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

, где halt - окончательное продолжение, завершающее программу.

Ответы [ 2 ]

1 голос
/ 17 октября 2019

Я преобразовал алгоритм в форму батута. Похоже на ФСМ. Есть цикл, который смотрит на текущее состояние, делает некоторые манипуляции и переходит в другое состояние. Также он использует два стека для разных видов продолжений.

Вот язык ввода (это подмножество языка, который я использовал изначально): 

// 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
1 голос
/ 17 октября 2019

Возможно, у ваших реальных проблем есть простые решения, позволяющие избежать большого потребления стека, поэтому, пожалуйста, не стесняйтесь добавлять детали. Однако, без дополнительных знаний о вашем конкретном коде, вот общий подход к сокращению потребления стека в рекурсивных программах, основанный на батутах и ​​продолжениях.

Walker

Вот типичная рекурсивная функцияэто не тривиально хвостовая рекурсия, написанная на 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:

  1. если форма является cons-ячейкой, рекурсивно пройтись по машине (соответственно 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)

Код обходит форму и сохраняет только числа, но сохраняет (не пустое) вложение.

Вызов trace на walk с помощьюПриведенный выше пример показывает максимальную глубину 8 вложенных вызовов.

Продолжения и батут

Вот адаптированная версия, называемая walk/then, которая просматривает форму, как и ранее, и когда результат доступен, свсе then на это. Здесь then - это продолжение .

Функция также возвращает thunk , то есть замыкание без параметров. Случается так, что когда мы возвращаем замыкание, стек разворачивается, и когда мы применяем thunk , он запускается из нового стека, но продвинулся в вычислениях (обычно я представляю, как кто-то поднимается по эскалатору). что идет вниз). Тот факт, что мы возвращаем thunk для уменьшения количества кадров стека, является частью trampoline .

Функция then принимает значение, а именно результат, который в конечном итоге будет проходить текущий обходвернуть. Таким образом, результат передается вниз стека, а то, что возвращается на каждом шаге, является функцией 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) ...)) выглядит следующим образом: обходит машину формы с аргументами 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), и глубина трассировки никогда не превышает 2 при трассировке walk/then.

См. статью Эли Бендерского , где можно найти еще один пример на Python.

...