正如最初在 cmets 中发布的那样，在 OCaml 中提前退出的惯用方法是使用延续。在您希望提前返回的地方，您创建一个延续，并将其传递给可能提前返回的代码。这比循环的标签更通用，因为您几乎可以从任何可以访问延续的东西中退出。
此外，正如 cmets 中所发布的，请注意 raise_notrace 用于您永远不希望运行时生成其跟踪的异常。
“天真的”第一次尝试：
module Continuation :
sig
(* This is the flaw with this approach: there is no good choice for
the result type. *)
type 'a cont = 'a -> unit
(* with_early_exit f passes a function "k" to f. If f calls k,
execution resumes as if with_early_exit completed
immediately. *)
val with_early_exit : ('a cont -> 'a) -> 'a
end =
struct
type 'a cont = 'a -> unit
(* Early return is implemented by throwing an exception. The ref
cell is used to store the value with which the continuation is
called - this is a way to avoid having to generate an exception
type that can store 'a for each 'a this module is used with. The
integer is supposed to be a unique identifier for distinguishing
returns to different nested contexts. *)
type 'a context = 'a option ref * int64
exception Unwind of int64
let make_cont ((cell, id) : 'a context) =
fun result -> cell := Some result; raise_notrace (Unwind id)
let generate_id =
let last_id = ref 0L in
fun () -> last_id := Int64.add !last_id 1L; !last_id
let with_early_exit f =
let id = generate_id () in
let cell = ref None in
let cont : 'a cont = make_cont (cell, id) in
try
f cont
with Unwind i when i = id ->
match !cell with
| Some result -> result
(* This should never happen... *)
| None -> failwith "with_early_exit"
end
let _ =
let nested_function i k = k 15; i in
Continuation.with_early_exit (nested_function 42)
|> string_of_int
|> print_endline
如您所见，上面通过隐藏异常实现了提前退出。延续实际上是一个部分应用的函数，它知道创建它的上下文的唯一 id，并且有一个引用单元格来存储结果值，同时将异常抛出到该上下文。上面的代码打印出 15。您可以将延续 k 传递到任意深度。您还可以在传递给with_early_exit 的位置立即定义函数f，产生类似于在循环上添加标签的效果。我经常使用这个。
上面的问题是'a cont的结果类型，我随意设置为unit。实际上，'a cont 类型的函数永远不会返回，因此我们希望它的行为类似于 raise——可用于任何类型的预期。但是，这不会立即起作用。如果您执行type ('a, 'b) cont = 'a -> 'b 之类的操作，并将其传递给嵌套函数，则类型检查器将在一个上下文中推断'b 的类型，然后强制您仅在具有相同类型的上下文中调用延续，即您将无法做类似的事情
(if ... then 3 else k 15)
...
(if ... then "s" else k 16)
因为第一个表达式强制'b 为int，但第二个表达式要求'b 为string。
为了解决这个问题，我们需要提供一个类似于raise 的函数来提前返回，即
(if ... then 3 else throw k 15)
...
(if ... then "s" else throw k 16)
这意味着远离纯粹的延续。我们必须取消部分应用上面的make_cont（我将其重命名为throw），并传递裸上下文：
module BetterContinuation :
sig
type 'a context
val throw : 'a context -> 'a -> _
val with_early_exit : ('a context -> 'a) -> 'a
end =
struct
type 'a context = 'a option ref * int64
exception Unwind of int64
let throw ((cell, id) : 'a context) =
fun result -> cell := Some result; raise_notrace (Unwind id)
let generate_id = (* Same *)
let with_early_exit f =
let id = generate_id () in
let cell = ref None in
let context = (cell, id) in
try
f context
with Unwind i when i = id ->
match !cell with
| Some result -> result
| None -> failwith "with_early_exit"
end
let _ =
let nested_function i k = ignore (BetterContinuation.throw k 15); i in
BetterContinuation.with_early_exit (nested_function 42)
|> string_of_int
|> print_endline
表达式throw k v 可用于需要不同类型的上下文中。
我在我从事的一些大型应用程序中普遍使用这种方法。我什至更喜欢它而不是常规例外。我有一个更复杂的变体，with_early_exit 的签名大致如下：
val with_early_exit : ('a context -> 'b) -> ('a -> 'b) -> 'b
第一个函数表示尝试做某事，第二个函数表示可能导致的'a 类型错误的处理程序。与变体和多态变体一起，这为异常处理提供了更明确的类型。它对多态变体尤其强大，因为编译器可以推断出错误变体集。
Jane Street 方法的效果与此处描述的相同，事实上，我之前有一个使用一流模块生成异常类型的实现。我不知道为什么我最终选择了这个——可能会有细微的差别:)