F#单声道中的StackOverflow，带连续性（启用尾部呼叫消除）

我正在运行一个用Continuations生成的解释器示例，尽管启用了尾部调用优化，但它在Mono JIT编译器版本4.3.0中失败，并出现stackoverflow错误。同样的代码在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

开放系统
开放系统运行时
让print x=printfn“%A”x
键入“数据环境=（字符串*”数据）列表
让rec lookup env x=
匹配环境
|[]->failwith（x+“未找到”）
|（y，v）：：yr->如果x=y，则v查找yr x
（*函数式语言的抽象语法，有例外*）
类型exn=
|字符串的Exn
类型expr=
|int的CstI
|布尔的CstB
|字符串变量
|让字符串*expr*expr
|字符串*expr*expr的Prim
|如果属于expr*expr*expr
|字符串*string*expr*expr（*（f，x，fbody，ebody）*）的乐音
|字符串*expr的调用
|提高exn
|使用expr*exn*expr（*使用exn->e2*尝试e1）
类型值=
|整数的整数
|字符串*字符串*表达式*值环境（*（f，x，fBody，fDeclEnv）*的闭包
类型答案=
|int的结果
|字符串中止
let rec coEval2（e:expr）（env:value-env）（cont:int->answer）
（经济：exn->回答）：回答=
匹配
|CstI i->cont i
|CstB b->cont（如果为b，则为1，否则为0）
|变量x->
将查找环境x与
|Int i->cont i
|->中止“coEval2变量”
|Prim（操作、e1、e2）->
科瓦尔2 e1环境
（乐趣1->
共青团2 e2环境
（乐趣12->
匹配
|“*”->cont（i1*i2）
|“+”->cont（i1+i2）
|“-”->续（i1-i2）
|“=”->cont（如果i1=i2，则为1，否则为0）
|“我用蹦床重新实现了
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))

//蹦床“跳跃”后，我们要么有一个结果（完成）
//或者我们需要再次“跳跃”（下一步）
类型结果结果可能只是被运行时之间的差异所影响。考虑到在没有优化的情况下，一个运行时比另一个运行时发生得更快，可能实际的错误是堆栈大小的差异？如果TCO不可用，IIRC Trampolines是解决此问题的一种方法。我在快速搜索中发现的最好方法是C#post:mono上的TCO是bugged，我认为它永远不会得到修复-上次我检查时，在F#将代码编译成循环的情况下，您是正常的，但一旦涉及到
tailcall
op代码，您就处于StackOverflow地形，因为运行时会很高兴地忽略这一点，在大多数情况下，我很担心这一点；（.有一半错误的功能比没有更糟糕。希望通过.NET core和类似的努力，这将有一天得到修复…这项工作很好。我使用CSP的目的是实现生成器、异常等。不知道蹦床是否也可以这样做？