F # StackOverflow в моно с продолжением (исключение блокировки звонка включено)

Question

Я использовал пример интерпретатора, сделанного с помощью Continuations, и он не смог выполнить компилятор Mono JIT версии 4.3.0 с ошибкой stackoverflow, несмотря на то, что оптимизация Tail Call включена. Тот же код отлично работает в Windows (.NET 4.6).

Это код:

open System 
open System.Runtime 

let print x = printfn "%A" x 

type 'data env = (string * 'data) list 

let rec lookup env x = 
    match env with 
    | []   -> failwith (x + " not found") 
    | (y, v)::yr -> if x=y then v else lookup yr x 

(* Abstract syntax of functional language with exceptions *) 

type exn = 
    | Exn of string 

type expr = 
    | CstI of int 
    | CstB of bool 
    | Var of string 
    | Let of string * expr * expr 
    | Prim of string * expr * expr 
    | If of expr * expr * expr 
    | Letfun of string * string * expr * expr  (* (f, x, fbody, ebody) *) 
    | Call of string * expr 
    | Raise of exn 
    | TryWith of expr * exn * expr     (* try e1 with exn -> e2 *) 

type value = 
    | Int of int 
    | Closure of string * string * expr * value env (* (f, x, fBody, fDeclEnv) *) 

type answer = 
    | Result of int 
    | Abort of string 


let rec coEval2 (e : expr) (env : value env) (cont : int -> answer) 
       (econt : exn -> answer) : answer = 
    match e with 
    | CstI i -> cont i 
    | CstB b -> cont (if b then 1 else 0) 
    | Var x -> 
     match lookup env x with 
     | Int i -> cont i 
     | _  -> Abort "coEval2 Var" 
    | Prim(ope, e1, e2) -> 
     coEval2 e1 env 
     (fun i1 -> 
     coEval2 e2 env 
      (fun i2 -> 
      match ope with 
      | "*" -> cont(i1 * i2) 
      | "+" -> cont(i1 + i2) 
      | "-" -> cont(i1 - i2) 
      | "=" -> cont(if i1 = i2 then 1 else 0) 
      | "<" -> cont(if i1 < i2 then 1 else 0) 
      | _ -> Abort "unknown primitive") econt) econt 
    | Let(x, eRhs, letBody) -> 
     coEval2 eRhs env (fun xVal -> 
         let bodyEnv = (x, Int xVal) :: env 
         coEval2 letBody bodyEnv cont econt) 
         econt 
    | If(e1, e2, e3) -> 
     coEval2 e1 env (fun b -> 
         if b<>0 then coEval2 e2 env cont econt 
           else coEval2 e3 env cont econt) econt 
    | Letfun(f, x, fBody, letBody) -> 
     let bodyEnv = (f, Closure(f, x, fBody, env)) :: env 
     coEval2 letBody bodyEnv cont econt 
    | Call(f, eArg) -> 
     let fClosure = lookup env f 
     match fClosure with 
     | Closure (f, x, fBody, fDeclEnv) -> 
     coEval2 eArg env 
      (fun xVal -> 
      let fBodyEnv = (x, Int xVal) :: (f, fClosure) :: fDeclEnv 
      coEval2 fBody fBodyEnv cont econt) 
      econt 
     | _ -> raise (Failure "eval Call: not a function") 
    | Raise exn -> econt exn 
    | TryWith (e1, exn, e2) -> 
     let econt1 thrown = 
      if thrown = exn then coEval2 e2 env cont econt 
          else econt thrown 
     coEval2 e1 env cont econt1 

    (* The top-level error continuation returns the continuation, 
     adding the text Uncaught exception *) 

let eval2 e env = 
    coEval2 e env 
     (fun v -> Result v) 
     (fun (Exn s) -> Abort ("Uncaught exception: " + s)) 

let run2 e = eval2 e [] 


(* Example: deep recursion to check for constant-space tail recursion *) 

let exdeep = Letfun("deep", "x", 
        If(Prim("=", Var "x", CstI 0), 
         CstI 1, 
         Call("deep", Prim("-", Var "x", CstI 1))), 
        Call("deep", Var "n")); 

let rundeep n = eval2 exdeep [("n", Int n)]; 

[<EntryPoint>] 
let main argv = 
    rundeep 10000 |> ignore 
    "All fine!" |> print 

    0 

Я обнаружил, что это проблема с МОНО, но мне интересно, если существует способ обойти это (я хочу сделать ПСУ реализовать несколько функций для переводчика)

Также известно, что отключение оптимизации хвостового вызова приводит к тому, что стекирование ошибок стека быстрее в окнах, чем на моно/osx.

Answer 1

Я переоценил coEval2 с использованием батута. Эта функция я умно назвал coEval3. coEval2 аварии для меня в Debug и работает в Release как и ожидалось. coEval3, похоже, работал для меня как в Debug, так и в Release.

// After "jumping" the trampoline we either have a result (Done) 
// or we need to "jump" again (Next) 
type result<'T> = 
    | Done of 'T 
    | Next of (unit -> result<'T>) 

let coEval3 (e : expr) (env : value env) (cont : int -> answer) (econt : exn -> answer) : answer = 
    // "Jumps" once producing either a result or a new "jump" 
    let rec jump (e : expr) (env : value env) (cont : int -> result<answer>) (econt : exn -> result<answer>)() : result<answer> = 
    match e with 
    | CstI i -> cont i 
    | CstB b -> cont (if b then 1 else 0) 
    | Var x -> 
     match lookup env x with 
     | Int i -> cont i 
     | _  -> Abort "coEval2 Var" |> Done 
    | Prim(ope, e1, e2) -> 
     jump e1 env 
     (fun i1 -> 
      jump e2 env 
      (fun i2 -> 
      match ope with 
      | "*" -> cont(i1 * i2) 
      | "+" -> cont(i1 + i2) 
      | "-" -> cont(i1 - i2) 
      | "=" -> cont(if i1 = i2 then 1 else 0) 
      | "<" -> cont(if i1 < i2 then 1 else 0) 
      | _ -> Abort "unknown primitive" |> Done) econt |> Next) econt |> Next 
    | Let(x, eRhs, letBody) -> 
     jump eRhs env (fun xVal -> 
         let bodyEnv = (x, Int xVal) :: env 
         jump letBody bodyEnv cont econt |> Next) 
         econt |> Next 
    | If(e1, e2, e3) -> 
     jump e1 env (fun b -> 
         if b<>0 then jump e2 env cont econt |> Next 
           else jump e3 env cont econt |> Next) econt |> Next 
    | Letfun(f, x, fBody, letBody) -> 
     let bodyEnv = (f, Closure(f, x, fBody, env)) :: env 
     jump letBody bodyEnv cont econt |> Next 
    | Call(f, eArg) -> 
     let fClosure = lookup env f 
     match fClosure with 
     | Closure (f, x, fBody, fDeclEnv) -> 
      jump eArg env 
      (fun xVal -> 
      let fBodyEnv = (x, Int xVal) :: (f, fClosure) :: fDeclEnv 
      jump fBody fBodyEnv cont econt |> Next) 
      econt |> Next 
     | _ -> raise (Failure "eval Call: not a function") 
    | Raise exn -> econt exn 
    | TryWith (e1, exn, e2) -> 
     let econt1 thrown = 
      if thrown = exn then jump e2 env cont econt |> Next 
          else econt thrown 
     jump e1 env cont econt1 |> Next 

    (* The top-level error continuation returns the continuation, 
     adding the text Uncaught exception *) 

    // If trampoline is tail-recursive F# will implement this as a loop, 
    // this is important for us as this means that the recursion is essentially 
    // turned into a loop 
    let rec trampoline j = 
    match j() with 
    | Done v -> v 
    | Next jj -> trampoline jj 

    let inline lift f v = f v |> Done 

    trampoline (jump e env (lift cont) (lift econt)) 

Надежда это несколько полезно