我正在运行一个使用Continuations制作的解释器的示例，尽管启用了Tail Call优化，但它在Mono JIT编译器版本4.3.0中失败并出现堆栈溢出错误。相同的代码在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
我发现这是MONO的一个问题，但我想知道是否有办法解决这个问题（我希望CSP为解释器实现几个功能）
值得注意的是，禁用尾调用优化会在窗口上比在mono / osx上更快地触发stackoverflow错误。
答案 0 :(得分：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))
希望这有点用处