正如最初在评论中发布的那样，在 OCaml 中提前退出的惯用方法是使用延续。在您希望提前返回的地方，您创建一个延续，并将其传递给可能提前返回的代码。这比循环的标签更通用，因为您几乎可以从任何可以访问延续的东西中退出。
此外，正如评论中所发布的，请注意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。您还可以f在传递给 的位置立即定义函数with_early_exit，从而产生类似于在循环上添加标签的效果。我经常使用这个。
'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 方法的效果与此处描述的相同，事实上，我之前有一个使用一流模块生成异常类型的实现。我不知道为什么我最终选择了这个——可能会有细微的差别:)