第 10 章：GADT（GADTs）

原文：Anil Madhavapeddy and Yaron Minsky, Real World OCaml: Functional Programming for the Masses, Second Edition, Chapter 10。维护者已确认本书为开源书籍，可翻译并发布用于学习研究。

广义代数数据类型（Generalized Algebraic Data Types，简称 GADT）是第 7 章“变体（Variants）”中所见变体的一种扩展。GADT 比普通变体更有表达力，能帮助你创建更精确匹配程序结构的类型。这可以让代码更安全、更简洁，也更高效。

与此同时，GADT 是 OCaml 的高级特性，它的能力也有明确代价。GADT 比普通变体更难使用，也不那么直观；有时要弄清楚如何有效使用它们，本身就像解一道小谜题。换句话说，只有当 GADT 能给设计带来质的提升时，才应该使用它。

不过，在合适的用例中，GADT 的确可以带来很大的改变。本章会通过几个例子，展示 GADT 支持的用例范围。

从核心上看，GADT 在普通变体之外提供了两个额外特性：

• 当你进入模式匹配的某个分支时，它能让编译器获得更多类型信息。
• 它让使用存在类型（existential types）变得容易；存在类型允许你处理某个具体但未知类型的数据。

如果不先看一些例子，这些特性会有点难理解。接下来我们就从例子开始。

10.1 一门小语言（A Little Language）

GADT 的一个经典用例，是编写带类型的表达式语言，类似第 7 章介绍的布尔表达式语言。本节会创建一门稍微丰富一些的语言，它允许混合算术表达式和布尔表达式。这意味着我们必须处理类型错误表达式的可能性，例如把 bool 和 int 相加的表达式。

先尝试用普通变体来做。这里会声明两个类型：value 表示语言中的原始值，也就是 int 或 bool；expr 表示所有可能的表达式。

open Base

type value =
  | Int of int
  | Bool of bool

type expr =
  | Value of value
  | Eq of expr * expr
  | Plus of expr * expr
  | If of expr * expr * expr

我们可以用相当直接的风格为这个类型写一个递归求值器。首先，声明一个异常，在遇到类型错误表达式时抛出，例如某个表达式试图把布尔值和整数相加。

exception Ill_typed

有了这个异常，就可以写求值器本身。

# let rec eval expr =
    match expr with
    | Value v -> v
    | If (c, t, e) ->
      (match eval c with
       | Bool b -> if b then eval t else eval e
       | Int _ -> raise Ill_typed)
    | Eq (x, y) ->
      (match eval x, eval y with
       | Bool _, _ | _, Bool _ -> raise Ill_typed
       | Int f1, Int f2 -> Bool (f1 = f2))
    | Plus (x, y) ->
      (match eval x, eval y with
       | Bool _, _ | _, Bool _ -> raise Ill_typed
       | Int f1, Int f2 -> Int (f1 + f2));;
val eval : expr -> value = <fun>

这个实现有些难看，因为它有很多动态检查，用来检测类型错误。事实上，完全可以构造出一个类型错误表达式来触发这些检查。

# let i x = Value (Int x)
  and b x = Value (Bool x)
  and (+:) x y = Plus (x,y);;
val i : int -> expr = <fun>
val b : bool -> expr = <fun>
val ( +: ) : expr -> expr -> expr = <fun>
# eval (i 3 +: b false);;
Exception: Ill_typed.

类型错误表达式的可能性不只是让实现变复杂；它对用户也是问题，因为用户很容易意外构造出类型错误表达式。

10.1.1 让语言具备类型安全（Making the Language Type-Safe）

先考虑一下，在没有 GADT 的情况下，这个 API 的类型安全版本可能长什么样。为了表达类型约束，我们需要给表达式加一个类型参数，用来区分整数表达式和布尔表达式。有了这样的参数，这门语言的签名可能如下：

module type Typesafe_lang_sig = sig
  type 'a t

  (** functions for constructing expressions *)

  val int : int -> int t
  val bool : bool -> bool t
  val if_ : bool t -> 'a t -> 'a t -> 'a t
  val eq : 'a t -> 'a t -> bool t
  val plus : int t -> int t -> int t

  (** Evaluation functions *)

  val int_eval : int t -> int
  val bool_eval : bool t -> bool
end

int_eval 和 bool_eval 这两个函数值得解释一下。你可能会期待有一个签名如下的单一求值函数：

val eval : 'a t -> 'a

但我们会看到，至少在不用 GADT 的情况下，没法实现这个函数。所以目前只能有两个不同的求值器，分别对应两类表达式。

现在写一个匹配这个签名的实现：

module Typesafe_lang : Typesafe_lang_sig = struct
  type 'a t = expr

  let int x = Value (Int x)
  let bool x = Value (Bool x)
  let if_ c t e = If (c, t, e)
  let eq x y = Eq (x, y)
  let plus x y = Plus (x, y)

  let int_eval expr =
    match eval expr with
    | Int x -> x
    | Bool _ -> raise Ill_typed

  let bool_eval expr =
    match eval expr with
    | Bool x -> x
    | Int _ -> raise Ill_typed
end

可以看到，之前有问题的类型错误表达式现在构造不出来，因为 OCaml 的类型系统会拒绝它。

# let expr = Typesafe_lang.(plus (int 3) (bool false));;
Line 1, characters 40-52:
Error: This expression has type bool t but an expression was expected of type
         int t
       Type bool is not compatible with type int

这里发生了什么？我们是怎样加入想要的类型安全性的？基本技巧是添加所谓的幻影类型（phantom type）。在下面这个定义中：

type 'a t = expr

类型参数 'a 就是幻影类型，因为它没有出现在 t 定义体中。

由于这个类型参数没有被使用，它可以自由取任意值。这意味着我们可以在签名中随意约束这个类型参数的使用，而我们正是利用这种自由来添加想要的类型安全规则。

从 API 角度看，这确实是一种改进；但从实现角度看，它甚至更糟。我们仍然有同一个求值器，以及其中所有用于类型错误的动态检查。而为了让这一套工作起来，我们还得写更多包装代码。

此外，幻影类型的纪律很容易出错。你可能没注意到，上面 eq 函数的类型其实是错的！

# Typesafe_lang.eq;;
- : 'a Typesafe_lang.t -> 'a Typesafe_lang.t -> bool Typesafe_lang.t = <fun>

它看起来对表达式类型是多态的，但求值器只支持对整数检查相等。因此，尽管用了幻影类型，我们仍然可以构造出类型错误表达式。

# let expr = Typesafe_lang.(eq (bool true) (bool false));;
val expr : bool Typesafe_lang.t = <abstr>
# Typesafe_lang.bool_eval expr;;
Exception: Ill_typed.

这也说明了为什么实现中仍然需要动态检查：实现内部的类型不一定能排除类型错误表达式。同一个事实也解释了为什么需要两个不同的 eval 函数：eval 的实现没有类型层面的保证，无法知道自己处理的是布尔表达式还是整数表达式，因此不能安全地返回一个随表达式结果类型变化的值。

10.1.2 尝试用普通变体做得更好（Trying to Do Better with Ordinary Variants）

为了看出为什么需要 GADT，我们先看看不用它们能走多远。具体来说，尝试把想要的类型规则直接编码进表达式类型定义里。做法是在 expr 和 value 类型上放一个普通类型参数，用来表示表达式或值的类型。

type 'a value =
  | Int of 'a
  | Bool of 'a

type 'a expr =
  | Value of 'a value
  | Eq of 'a expr * 'a expr
  | Plus of 'a expr * 'a expr
  | If of bool expr * 'a expr * 'a expr

乍看起来这很有希望，但它并没有真正做成我们想要的事。稍微试验一下：

# let i x = Value (Int x)
  and b x = Value (Bool x)
  and (+:) x y = Plus (x,y);;
val i : 'a -> 'a expr = <fun>
val b : 'a -> 'a expr = <fun>
val ( +: ) : 'a expr -> 'a expr -> 'a expr = <fun>
# i 3;;
- : int expr = Value (Int 3)
# b false;;
- : bool expr = Value (Bool false)
# i 3 +: i 4;;
- : int expr = Plus (Value (Int 3), Value (Int 4))

到目前为止都不错。但只要想一分钟，就会发现这并没有达到目标。一方面，外层表达式的类型总是等于内层表达式的类型，这意味着有些本该通过类型检查的东西不能通过。

# If (Eq (i 3, i 4), i 0, i 1);;
Line 1, characters 9-12:
Error: This expression has type int expr
       but an expression was expected of type bool expr
       Type int is not compatible with type bool

另一方面，有些不该通过类型检查的东西却能通过。

# b 3;;
- : int expr = Value (Bool 3)

问题在于，我们想使用这个类型参数的方式，并不是普通变体所支持的。具体来说，我们希望这个类型参数在不同标签中以不同方式填充，并且以非平凡的方式依赖每个标签关联数据的类型。这正是 GADT 能帮上忙的地方。

10.1.3 GADT 来救场（GADTs to the Rescue）

现在可以写第一个 GADT 了。下面是 value 和 expr 类型的新版本，它们正确编码了我们想要的类型规则。

type _ value =
  | Int : int -> int value
  | Bool : bool -> bool value

type _ expr =
  | Value : 'a value -> 'a expr
  | Eq : int expr * int expr -> bool expr
  | Plus : int expr * int expr -> int expr
  | If : bool expr * 'a expr * 'a expr -> 'a expr

这里的语法需要稍微拆解。每个标签右侧的冒号，说明这是一个 GADT。在冒号右边，你会看到类似普通单参数函数类型的东西，也几乎可以把它当成函数类型来看；更具体地说，可以把它看作这个特定标签作为类型构造器时的类型签名。箭头左侧说明构造器参数的类型，箭头右侧决定被构造值的类型。

在 GADT 的每个标签定义中，箭头右侧都是整个 GADT 类型的某个实例，并且每个分支可以独立选择类型参数。重要的是，类型参数既可以依赖标签，也可以依赖参数类型。Eq 是一个类型参数完全由标签决定的例子：它总是对应 bool expr。If 则是类型参数依赖标签参数的例子，具体来说，If 的类型参数是 then 分支和 else 分支的类型参数。

试几个例子：

# let i x = Value (Int x)
  and b x = Value (Bool x)
  and (+:) x y = Plus (x,y);;
val i : int -> int expr = <fun>
val b : bool -> bool expr = <fun>
val ( +: ) : int expr -> int expr -> int expr = <fun>
# i 3;;
- : int expr = Value (Int 3)
# b 3;;
Line 1, characters 3-4:
Error: This expression has type int but an expression was expected of type
         bool
# i 3 +: i 6;;
- : int expr = Plus (Value (Int 3), Value (Int 6))
# i 3 +: b false;;
Line 1, characters 8-15:
Error: This expression has type bool expr
       but an expression was expected of type int expr
       Type bool is not compatible with type int

可以看到，之前用签名层面的幻影类型约束强制执行的类型安全规则，现在被直接编码在表达式类型定义中了。

这些类型安全规则不仅适用于构造表达式，也适用于拆解表达式。这意味着我们可以写一个更简单、更简洁的求值器，不再需要任何类型安全检查。

# let eval_value : type a. a value -> a = function
    | Int x -> x
    | Bool x -> x;;
val eval_value : 'a value -> 'a = <fun>
# let rec eval : type a. a expr -> a = function
    | Value v -> eval_value v
    | If (c, t, e) -> if eval c then eval t else eval e
    | Eq (x, y) -> eval x = eval y
    | Plus (x, y) -> eval x + eval y;;
val eval : 'a expr -> 'a = <fun>

注意，现在我们有了单一的多态 eval 函数，而不像使用幻影类型时那样需要两个类型特定的求值器。

10.1.4 GADT、局部抽象类型与多态递归（GADTs, Locally Abstract Types, and Polymorphic Recursion）

上面的例子也展示了 GADT 的一个缺点：使用它们的代码需要额外的类型标注。看看如果不加标注来定义 eval_value 会发生什么：

# let eval_value = function
    | Int x -> x
    | Bool x -> x;;
Line 3, characters 7-13:
Error: This pattern matches values of type bool value
       but a pattern was expected which matches values of type int value
       Type bool is not compatible with type int

问题在于，OCaml 默认不愿意在同一个函数体中以不同方式实例化普通类型变量，而这里恰好需要这样做。我们可以加入一个局部抽象类型（locally abstract type）来解决，它没有这个限制。

# let eval_value (type a) (v : a value) : a =
    match v with
    | Int x -> x
    | Bool x -> x;;
val eval_value : 'a value -> 'a = <fun>

这和前面写的标注并不一样。实际上，如果用这种方式写 eval，会发现它并不工作。

# let rec eval (type a) (e : a expr) : a =
    match e with
    | Value v -> eval_value v
    | If (c, t, e) -> if eval c then eval t else eval e
    | Eq (x, y) -> eval x = eval y
    | Plus (x, y) -> eval x + eval y;;
Line 4, characters 43-44:
Error: This expression has type a expr but an expression was expected of type
         bool expr
       Type a is not compatible with type bool

这个错误消息不是很有帮助，但基本问题是 eval 是递归的，而 GADT 的类型推断和递归调用配合得并不好。

更具体地说，问题在于类型检查器试图把局部抽象类型 a 合并进递归函数 eval 的类型中；而把它合并到定义 eval 的外层作用域，就是 a 逃逸出其作用域的方式。

可以通过显式标记 eval 为多态函数来解决。OCaml 为此提供了一个方便的类型标注。

# let rec eval : 'a. 'a expr -> 'a =
    fun (type a) (x : a expr) ->
     match x with
     | Value v -> eval_value v
     | If (c, t, e) -> if eval c then eval t else eval e
     | Eq (x, y) -> eval x = eval y
     | Plus (x, y) -> eval x + eval y;;
val eval : 'a expr -> 'a = <fun>

这能工作，是因为把 eval 标记为多态后，eval 的类型不会被专门化为 a，因此 a 不会逃逸出它的作用域。

这也很有帮助，因为 eval 本身就是多态递归（polymorphic recursion）的一个例子。也就是说，eval 需要以多个不同类型调用自身。例如 If 就会遇到这种情况：If 的条件必须是 bool 类型，但 then 和 else 分支的类型可能是 int。这意味着在求值 If 时，我们会以不同于调用点的类型分派 eval。

因此，eval 需要把自身看作多态函数。这种多态性基本不可能自动推断出来，这也是我们需要显式标注 eval 多态性的第二个原因。

上面的语法有点啰嗦，所以 OCaml 提供了语法糖，把多态性标注和局部抽象类型的创建结合起来：

# let rec eval : type a. a expr -> a = function
    | Value v -> eval_value v
    | If (c, t, e) -> if eval c then eval t else eval e
    | Eq (x, y) -> eval x = eval y
    | Plus (x, y) -> eval x + eval y;;
val eval : 'a expr -> 'a = <fun>

当你编写任何使用 GADT 的递归函数时，这类标注通常都是正确选择。

10.2 GADT 什么时候有用？（When Are GADTs Useful?）

上面展示的带类型语言是一个完全合理的例子，但 GADT 的用途远不止于设计小语言。本节会更广泛地展示一些 GADT 能做的事情。

10.2.1 改变返回类型（Varying Your Return Type）

有时，你希望写一个单一函数，让它在不同情况下拥有不同类型。从某种意义上说，这很普通。毕竟，OCaml 的多态意味着值可以在不同上下文中采用不同类型。List.find 就是一个很好的例子。它的签名表明，结果类型随输入列表的类型变化。

# List.find;;
- : 'a list -> f:('a -> bool) -> 'a option = <fun>

当然，你也可以用 List.find 产生不同类型的值。

# List.find ~f:(fun x -> x > 3) [1;3;5;2];;
- : int option = Some 5
# List.find ~f:(Char.is_uppercase) ['a';'B';'C'];;
- : char option = Some 'B'

但这种方式仅限于类型之间的简单依赖关系，也就是那些对应代码中数据流动方式的依赖。有时，你希望类型以更灵活的方式变化。

为了具体说明，假设我们想创建一个版本的 find，并且可以配置它在找不到元素时如何处理。可能有三种想要的行为：

• 抛出异常。
• 返回 None。
• 返回一个默认值。

先尝试不用 GADT 写出具有这些行为的函数。首先创建一个变体类型，表示三种可能行为。

module If_not_found = struct
  type 'a t =
    | Raise
    | Return_none
    | Default_to of 'a
end

现在可以编写 flexible_find，它接受一个 If_not_found.t 参数，并据此改变行为。

# let rec flexible_find list ~f (if_not_found : _ If_not_found.t) =
    match list with
    | hd :: tl ->
      if f hd then Some hd else flexible_find ~f tl if_not_found
    | [] ->
      (match if_not_found with
      | Raise -> failwith "Element not found"
      | Return_none -> None
      | Default_to x -> Some x);;
val flexible_find :
  'a list -> f:('a -> bool) -> 'a If_not_found.t -> 'a option = <fun>

下面是这个函数的几个使用示例：

# flexible_find ~f:(fun x -> x > 10) [1;2;5] Return_none;;
- : int option = None
# flexible_find ~f:(fun x -> x > 10) [1;2;5] (Default_to 10);;
- : int option = Some 10
# flexible_find ~f:(fun x -> x > 10) [1;2;5] Raise;;
Exception: (Failure "Element not found").
# flexible_find ~f:(fun x -> x > 10) [1;2;20] Raise;;
- : int option = Some 20

这基本做到了我们想要的事，但问题是 flexible_find 总是返回 option，即使传入的是 Raise 或 Default_to，这两种情况下其实保证不会使用 None 分支。

为了在 Raise 和 Default_to 情况下去掉不必要的 option，我们要把 If_not_found.t 改成 GADT。具体来说，把它定义成带两个类型参数的 GADT：一个表示列表元素类型，一个表示函数返回类型。

module If_not_found = struct
  type (_, _) t =
    | Raise : ('a, 'a) t
    | Return_none : ('a, 'a option) t
    | Default_to : 'a -> ('a, 'a) t
end

可以看到，Raise 和 Default_to 的元素类型与返回类型相同，而 Return_none 提供的是可选返回值。

下面是利用这个 GADT 的 flexible_find 定义。

# let rec flexible_find
   : type a b. f:(a -> bool) -> a list -> (a, b) If_not_found.t -> b =
   fun ~f list if_not_found ->
    match list with
    | [] ->
      (match if_not_found with
      | Raise -> failwith "No matching item found"
      | Return_none -> None
      | Default_to x -> x)
    | hd :: tl ->
      if f hd
      then (
        match if_not_found with
        | Raise -> hd
        | Return_none -> Some hd
        | Default_to _ -> hd)
      else flexible_find ~f tl if_not_found;;
val flexible_find :
  f:('a -> bool) -> 'a list -> ('a, 'b) If_not_found.t -> 'b = <fun>

从 flexible_find 的签名可以看到，返回值现在依赖 If_not_found.t 的类型，也就是可以依赖具体使用的是 If_not_found.t 的哪个变体。结果是，flexible_find 只有在需要时才返回 option。

# flexible_find ~f:(fun x -> x > 10) [1;2;5] Return_none;;
- : int option = Base.Option.None
# flexible_find ~f:(fun x -> x > 10) [1;2;5] (Default_to 10);;
- : int = 10
# flexible_find ~f:(fun x -> x > 10) [1;2;5] Raise;;
Exception: (Failure "No matching item found").
# flexible_find ~f:(fun x -> x > 10) [1;2;20] Raise;;
- : int = 20

10.2.2 捕获未知（Capturing the Unknown）

处理未知类型的代码在 OCaml 中很常见，最简单的例子中就会出现：

# let tuple x y = (x,y);;
val tuple : 'a -> 'b -> 'a * 'b = <fun>

类型变量 'a 和 'b 表明这里有两个未知类型，并且这些类型变量是全称量化（universally quantified）的。也就是说，tuple 的类型是：对所有类型 a 和 b，都有 a -> b -> a * b。

事实上，我们可以把 tuple 的类型限制为任意想要的 'a 和 'b。

# (tuple : int -> float -> int * float);;
- : int -> float -> int * float = <fun>
# (tuple : string -> string * string -> string * (string * string));;
- : string -> string * string -> string * (string * string) = <fun>

不过，有时我们想要的是存在量化（existentially quantified）的类型变量。它并不是兼容所有类型，而是代表某个具体但未知的类型。

GADT 提供了编码这种类型变量的一种自然方式。下面是一个简单例子。

type stringable =
  Stringable : { value: 'a; to_string: 'a -> string } -> stringable

这个类型把某个任意类型的值，和一个能把该类型值转换成字符串的函数打包在一起。

我们能看出 'a 是存在量化的，因为它出现在箭头左侧，却没有出现在箭头右侧。因此，内部出现的 'a 并没有成为 stringable 本身的类型参数。本质上，这个存在量化类型被绑定在 stringable 的定义内部。

下面这个函数可以打印任意 stringable：

# let print_stringable (Stringable s) =
    Stdio.print_endline (s.to_string s.value);;
val print_stringable : stringable -> unit = <fun>

我们可以把 print_stringable 用在一组底层类型不同的 stringable 上。

# let stringables =
    (let s value to_string = Stringable { to_string; value } in
      [ s 100 Int.to_string
      ; s 12.3 Float.to_string
      ; s "foo" Fn.id
      ]);;
val stringables : stringable list =
  [Stringable {value = <poly>; to_string = <fun>};
   Stringable {value = <poly>; to_string = <fun>};
   Stringable {value = <poly>; to_string = <fun>}]
# List.iter ~f:print_stringable stringables;;
100
12.3
foo
- : unit = ()

让这一切能够工作的关键，是底层对象的类型被存在性地绑定在 stringable 类型内部。因此，底层值的类型不能逃出 stringable 的作用域；任何试图返回这种值的函数都无法通过类型检查。

# let get_value (Stringable s) = s.value;;
Line 1, characters 32-39:
Error: This expression has type $Stringable_'a
       but an expression was expected of type 'a
       The type constructor $Stringable_'a would escape its scope

值得花点时间解释这个错误消息，尤其是类型变量 $Stringable_'a 的含义。可以把这个变量看作由三部分组成：

• $ 标记这个变量是存在类型。
• Stringable 是这个变量来自的 GADT 标签名。
• 'a 是该标签内部类型变量的名字。

10.2.3 抽象计算机器（Abstracting Computational Machines）

OCaml 中常见的一种习惯用法，是用一组组合组件的函数，也就是组合器（combinators），把小组件组合成更大的计算机器。

GADT 有助于编写这类组合器。为了说明这一点，我们考虑一个例子：管道（pipelines）。这里的管道是一系列步骤，每个步骤消费前一步的输出，可能产生一些副作用，并返回一个传给下一步的值。这类似 shell 管道，对各种系统自动化任务都很有用。

不过，我们不是已经能写管道了吗？毕竟，OCaml 自带了一个完全可用的管道操作符：

# open Core;;
# let sum_file_sizes () =
    Sys_unix.ls_dir "."
    |> List.filter ~f:Sys_unix.is_file_exn
    |> List.map ~f:(fun file_name -> (Core_unix.lstat file_name).st_size)
    |> List.sum (module Int) ~f:Int64.to_int_exn;;
val sum_file_sizes : unit -> int = <fun>

这已经足够好用，但自定义管道类型的优点在于，它让你能在基本执行之外构建额外服务，例如：

• 性能分析：运行管道时，获得每个步骤耗时的报告。
• 对执行的控制：例如允许用户在执行中途暂停管道，并稍后重启。
• 自定义错误处理：例如构建一个能记录失败位置，并提供重启可能性的管道。

这类管道类型的签名大概如下：

module type Pipeline = sig
  type ('input,'output) t

  val ( @> ) : ('a -> 'b) -> ('b,'c) t -> ('a,'c) t
  val empty : ('a,'a) t
end

这里，类型 ('a,'b) t 表示一个消费 'a 类型值并产生 'b 类型值的管道。操作符 @> 允许你通过提供一个函数，把一个步骤前置到现有管道前面；empty 给出一个空管道，可用作管道的起点。

下面展示了如何用这个 API 构建类似前面 |> 示例的管道。这里使用了函子（functor），也就是第 11 章会更详细介绍的内容。通过函子，我们可以在实现管道 API 之前，先写出使用该 API 的代码。

# module Example_pipeline (Pipeline : Pipeline) = struct
    open Pipeline
    let sum_file_sizes =
      (fun () -> Sys_unix.ls_dir ".")
      @> List.filter ~f:Sys_unix.is_file_exn
      @> List.map ~f:(fun file_name -> (Core_unix.lstat file_name).st_size)
      @> List.sum (module Int) ~f:Int64.to_int_exn
      @> empty
  end;;
module Example_pipeline :
  functor (Pipeline : Pipeline) ->
    sig val sum_file_sizes : (unit, int) Pipeline.t end

如果我们只想要一个能朴素执行的管道，可以把管道本身定义成简单函数，把 @> 操作符定义成函数组合。这样，执行管道就是函数应用。

module Basic_pipeline : sig
   include Pipeline
   val exec : ('a,'b) t -> 'a -> 'b
 end= struct
  type ('input, 'output) t = 'input -> 'output

  let empty = Fn.id

  let ( @> ) f t input =
    t (f input)

  let exec t input = t input
end

但这种管道实现方式无法提供前面讨论的额外服务。我们实际做的，只是逐步构建一种用 |> 操作符也能得到的函数。

我们可以通过增强管道类型来获得更强大的管道，为它加入额外运行时结构，用来跟踪性能分析、处理异常，或者提供特定用例需要的其他能力。但这种方式很笨拙，因为它要求我们预先承诺要支持哪些服务，并把这些服务全部嵌入管道表示中。

GADT 提供了更简单的方法。我们不必具体构建一台执行管道的机器，而是可以用 GADT 抽象地表示想要的管道，然后在这个表示之上构建所需功能。

这样的表示可以如下：

type (_, _) pipeline =
  | Step : ('a -> 'b) * ('b, 'c) pipeline -> ('a, 'c) pipeline
  | Empty : ('a, 'a) pipeline

这里的标签表示管道的两个构建块：Step 对应 @> 操作符，Empty 对应空管道，如下所示。

# let ( @> ) f pipeline = Step (f,pipeline);;
val ( @> ) : ('a -> 'b) -> ('b, 'c) pipeline -> ('a, 'c) pipeline = <fun>
# let empty = Empty;;
val empty : ('a, 'a) pipeline = Empty

有了这些，就能相当容易地做一个朴素的管道执行器。

# let rec exec : type a b. (a, b) pipeline -> a -> b =
   fun pipeline input ->
    match pipeline with
    | Empty -> input
    | Step (f, tail) -> exec tail (f input);;
val exec : ('a, 'b) pipeline -> 'a -> 'b = <fun>

但我们也可以做更有趣的事。例如，下面这个函数会执行管道，并生成一份性能分析信息，显示管道每一步花了多长时间。

# let exec_with_profile pipeline input =
    let rec loop
        : type a b.
          (a, b) pipeline -> a -> Time_ns.Span.t list -> b * Time_ns.Span.t list
      =
     fun pipeline input rev_profile ->
      match pipeline with
      | Empty -> input, rev_profile
      | Step (f, tail) ->
        let start = Time_ns.now () in
        let output = f input in
        let elapsed = Time_ns.diff (Time_ns.now ()) start in
        loop tail output (elapsed :: rev_profile)
    in
    let output, rev_profile = loop pipeline input [] in
    output, List.rev rev_profile;;
val exec_with_profile : ('a, 'b) pipeline -> 'a -> 'b * Time_ns.Span.t list =
  <fun>

用这种更抽象的 GADT 方式创建小型组合器库，相比让组合器构建更具体的计算机器，有几个优点：

• 核心类型更简单，因为它们通常由 GADT 标签构成，而这些标签只是基础组合器类型的映射。
• 设计更模块化，因为核心类型不需要预先考虑你可能想用它做的每一种用途。
• 代码往往更高效，因为更具体的方法通常需要分配闭包来封装必要功能，而闭包比 GADT 标签更重。

10.2.4 收窄可能性（Narrowing the Possibilities）

GADT 的另一个用例，是在不同情况下收窄某个数据类型的可能状态集合。

这种能力在管理复杂应用状态时很有用，因为可用数据会随时间变化。我们考虑一个简单例子：正在编写代码处理用户登录请求，并想检查相关用户是否被授权登录。

假设登录用户已经通过某个名字完成认证，但为了授权，还需要做两件事：把用户名转换成数值用户 ID，并获取相关服务的权限；一旦两者都有，就可以检查这个用户 ID 是否允许登录。

如果不用 GADT，可以把单个登录请求的状态建模如下：

type logon_request =
  { user_name : User_name.t
  ; user_id : User_id.t option
  ; permissions : Permissions.t option
  }

这里，User_name.t 表示文本名称，User_id.t 表示与用户关联的整数标识符，Permissions.t 则允许你判断哪些 User_id.t 有权登录。

下面是一个测试给定请求是否被授权的函数：

# let authorized request =
    match request.user_id, request.permissions with
    | None, _ | _, None ->
      Error "Can't check authorization: data incomplete"
    | Some user_id, Some permissions ->
      Ok (Permissions.check permissions user_id);;
val authorized : logon_request -> (bool, string) result = <fun>

我们的意图是只在数据完整后调用这个函数，也就是 user_id 和 permissions 字段都已经填好之后。因此，如果数据不完整，它就会返回错误。

对于这种简单情况，上面的代码工作得很好。但在真实系统中，代码可能以多种方式变得更复杂，例如：

• 需要管理更多字段，包括更多可选字段；
• 更多操作依赖这些可选字段；
• 并行处理多个请求，而每个请求可能处于不同完成状态。

随着这类复杂度增长，能够在类型层面跟踪某个请求的状态，并用它来收窄该请求可能处于的状态集合，会很有帮助。这样可以移除一些额外的分支分析和错误处理，从而降低代码复杂度，并减少犯错机会。

一种做法是创建不同类型来表示请求的不同状态，例如一种类型表示字段仍然可选的不完整请求，另一种类型表示所有数据都是必填的完整请求。

这能工作，但可能笨拙且冗长。借助 GADT，可以在一个类型参数中跟踪请求状态，并使用这个参数收窄可用分支集合，而不必重复定义类型。

10.2.4.1 对完成状态敏感的 option 类型（A Completion-Sensitive Option Type）

先创建一个对请求完整状态敏感的 option 类型。为此，需要先创建表示完整和不完整状态的类型。

type incomplete = Incomplete
type complete = Complete

这些类型的定义本身并不重要，因为我们永远不会实例化这些类型，只会把它们用作不同状态的标记。重要的是这些类型彼此不同。

现在可以创建一个对完整状态敏感的 option 类型。注意这里有两个类型变量：第一个表示 option 内容的类型，第二个表示它是否用于不完整状态。

type (_, _) coption =
  | Absent : (_, incomplete) coption
  | Present : 'a -> ('a, _) coption

这里使用 Absent 和 Present，而不是 Some 或 None，是为了在同时使用 option 和 coption 时减少混淆。

你可能注意到，我们并没有显式使用 complete。这里的做法是确保只有 incomplete coption 才能是 Absent。因此，一个 complete 的 coption 不是 incomplete，也就只能是 Present。

用例子更容易理解。考虑下面这个从 coption 中取值的函数，如果发现 Absent，就返回默认值。

# let get ~default o =
     match o with
     | Present x -> x
     | Absent -> default;;
val get : default:'a -> ('a, incomplete) coption -> 'a = <fun>

注意这里推断出了 incomplete 类型。如果把 coption 标注为 complete，代码就无法编译。

# let get ~default (o : (_,complete) coption) =
    match o with
    | Absent -> default
    | Present x -> x;;
Line 3, characters 7-13:
Error: This pattern matches values of type ('a, incomplete) coption
       but a pattern was expected which matches values of type
         ('a, complete) coption
       Type incomplete is not compatible with type complete

删除 Absent 分支，以及现在没用的 default 参数，就可以编译。

# let get (o : (_,complete) coption) =
    match o with
    | Present x -> x;;
val get : ('a, complete) coption -> 'a = <fun>

也可以把它写得更简单：

# let get (Present x : (_,complete) coption) = x;;
val get : ('a, complete) coption -> 'a = <fun>

可以看到，当 coption 已知为 complete 时，模式匹配被收窄到只有 Present 分支。

10.2.4.2 对完成状态敏感的请求类型（A Completion-Sensitive Request Type）

可以用 coption 定义一个对完成状态敏感的 logon_request 版本。

type 'c logon_request =
  { user_name : User_name.t
  ; user_id : (User_id.t, 'c) coption
  ; permissions : (Permissions.t, 'c) coption
  }

logon_request 有一个类型参数，用来标记它是否 complete。当它为 complete 时，user_id 和 permissions 字段也都会是 complete。

和以前一样，填充 user_id 和 permissions 字段很容易。

# let set_user_id request x = { request with user_id = Present x };;
val set_user_id : 'a logon_request -> User_id.t -> 'a logon_request = <fun>
# let set_permissions request x = { request with permissions = Present x };;
val set_permissions : 'a logon_request -> Permissions.t -> 'a logon_request =
  <fun>

注意，填充字段并不会自动把请求标记为 complete。为此，需要显式测试完整性，然后构造一个只包含已完成字段的记录版本。

# let check_completeness request =
    match request.user_id, request.permissions with
    | Absent, _ | _, Absent -> None
    | (Present _ as user_id), (Present _ as permissions) ->
      Some { request with user_id; permissions };;
val check_completeness : incomplete logon_request -> 'a logon_request option =
  <fun>

结果是多态的，意味着它可以返回任意种类的登录请求，其中包括返回完整请求的可能性。实践中，如果显式约束返回值为 complete 请求，这个函数类型会更容易理解。

# let check_completeness request : complete logon_request option =
    match request.user_id, request.permissions with
    | Absent, _ | _, Absent -> None
    | (Present _ as user_id), (Present _ as permissions) ->
      Some { request with user_id; permissions };;
val check_completeness :
  incomplete logon_request -> complete logon_request option = <fun>

最后，可以写一个授权检查器，它无条件作用于完整登录请求。

# let authorized (request : complete logon_request) =
    let { user_id = Present user_id; permissions = Present permissions; _ } = request in
    Permissions.check permissions user_id;;
val authorized : complete logon_request -> bool = <fun>

做了这么多工作之后，结果可能显得有点平淡。确实，多数时候，这类收窄并不值得付出设置它的复杂度。但对于足够复杂的状态机，减少代码需要考虑的可能性，会显著提升结果的可理解性和正确性。

10.2.4.3 类型区分性与抽象（Type Distinctness and Abstraction）

在本节的例子中，我们用了 complete 和 incomplete 两个类型来标记不同状态，并把这些类型定义得在某种意义上显然不同。

type incomplete = Incomplete
type complete = Complete

这并不是严格必要的。下面是另一种定义方式，它们看起来没那么明显地区分开。

type incomplete = Z
type complete = Z

OCaml 的变体类型是名义化的（nominal），所以即使 complete 和 incomplete 拥有同名变体，它们仍然是不同类型。把两个类型的实例放进同一个列表时，就能看到这一点。

# let i = (Z : incomplete) and c = (Z : complete);;
val i : incomplete = Z
val c : complete = Z
# [i; c];;
Line 1, characters 5-6:
Error: This expression has type complete
       but an expression was expected of type incomplete

因此，可以像前面那样用这些类型作为索引来收窄模式匹配。首先设置 coption 类型：

type ('a, _) coption =
  | Absent : (_, incomplete) coption
  | Present : 'a -> ('a, _) coption

然后写一个要求 coption 完整的函数，因此只需要考虑 Present 分支。

# let assume_complete (coption : (_,complete) coption) =
    match coption with
    | Present x -> x;;
val assume_complete : ('a, complete) coption -> 'a = <fun>

这里有一个很容易忽略的问题：通过接口暴露这些类型的方式，可能会让 OCaml 丢失这些类型之间的区分性。考虑下面这个版本，它完全隐藏了 complete 和 incomplete 的定义。

module M : sig
  type incomplete
  type complete
end = struct
  type incomplete = Z
  type complete = Z
end
include M

type ('a, _) coption =
  | Absent : (_, incomplete) coption
  | Present : 'a -> ('a, _) coption

现在，前面写的 assume_complete 函数不再被认为是穷尽的。

# let assume_complete (coption : (_,complete) coption) =
    match coption with
    | Present x -> x;;
Lines 2-3, characters 5-21:
Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Absent
val assume_complete : ('a, complete) coption -> 'a = <fun>

这是因为一旦把这些类型保持抽象，我们就完全隐藏了底层类型，让类型系统没有证据证明它们彼此不同。

看看如果暴露这些类型的实现会发生什么：

module M : sig
  type incomplete = Z
  type complete = Z
end = struct
  type incomplete = Z
  type complete = Z
end
include M

type ('a, _) coption =
  | Absent : (_, incomplete) coption
  | Present : 'a -> ('a, _) coption

但结果仍然不是穷尽的！

# let assume_complete (coption : (_,complete) coption) =
    match coption with
    | Present x -> x;;
Lines 2-3, characters 5-21:
Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Absent
val assume_complete : ('a, complete) coption -> 'a = <fun>

为了让匹配穷尽，暴露出来的类型需要明确不同。如果像最初那样，把它们定义成带不同标签名的变体，就能满足这一点。

原因在于，接口中看似不同的类型，在实现中可能其实相同，如下所示。

module M : sig
  type incomplete = Z
  type complete = Z
end = struct
  type incomplete = Z
  type complete = incomplete = Z
end

这一切说明：当你创建类型作为 GADT 类型参数的抽象标记时，应该选择能清楚体现这些类型彼此不同的定义，并且应该在 mli 中暴露这些定义。

10.2.4.4 不用 GADT 的收窄（Narrowing Without GADTs）

到目前为止，我们只在 GADT 的语境中看到了收窄，但 OCaml 也能从普通变体中消除不可能分支。和 GADT 一样，要消除某个分支，需要在类型层面证明这个分支不可能出现。

一种做法是使用无人居住类型（uninhabited type），也就是没有任何关联值的类型。可以通过创建一个没有任何标签的变体来声明这类类型。

type nothing = |

这个想法很有用，所以 Base 提供了一个标准无人居住类型：Nothing.t。

那么，无人居住类型有什么用？考虑第 8 章讨论过的 Result.t 类型。通常，要匹配一个 Result.t，需要同时处理 Ok 和 Error 分支。

# open Stdio;;
# let print_result (x : (int,string) Result.t) =
    match x with
    | Ok x -> printf "%d\n" x
    | Error x -> printf "ERROR: %s\n" x;;
val print_result : (int, string) result -> unit = <fun>

但如果 Error 分支包含的是无人居住类型，那么这个分支永远不能被实例化，OCaml 也会告诉你这一点。

# let print_result (x : (int, Nothing.t) Result.t) =
    match x with
    | Ok x -> printf "%d\n" x
    | Error _ -> printf "ERROR\n";;
Line 4, characters 7-14:
Warning 56 [unreachable-case]: this match case is unreachable.
Consider replacing it with a refutation case '<pat> -> .'
val print_result : (int, Nothing.t) result -> unit = <fun>

可以遵循上面的建议，加入所谓的反驳分支（refutation case）。

# let print_result (x : (int, Nothing.t) Result.t) =
    match x with
    | Ok x -> printf "%d\n" x
    | Error _ -> .;;
val print_result : (int, Nothing.t) result -> unit = <fun>

最后一个分支中的句点告诉编译器，我们认为这个分支永远不可达，而 OCaml 会验证这是真的。不过在一些简单情况下，编译器可以自动为你加入反驳分支，所以不必显式写出来。

# let print_result (x : (int, Nothing.t) Result.t) =
    match x with
    | Ok x -> printf "%d\n" x;;
val print_result : (int, Nothing.t) result -> unit = <fun>

当使用高度可配置、支持多种使用模式的库时，无人居住类型带来的收窄可能很有用；某个特定应用不一定需要所有模式。Async 的 RPC（remote procedure-call）库就是一个例子。Async RPC 支持一种交互形式，叫作 State_rpc。这种 RPC 由四个类型参数化，对应四类数据：

• query：初始客户端请求；
• state：服务器返回的初始快照；
• update：针对该快照的一系列更新；
• error：终止流的错误。

现在，假设你想在不需要用自定义错误终止流的场景中使用 State_rpc。一种做法是直接用 unit 作为错误类型来实例化 State_rpc。

open Core
open Async
let rpc =
  Rpc.State_rpc.create
    ~name:"int-map"
    ~version:1
    ~bin_query:[%bin_type_class: unit]
    ~bin_state:[%bin_type_class: int Map.M(String).t]
    ~bin_update:[%bin_type_class: int Map.M(String).t]
    ~bin_error:[%bin_type_class: unit]
    ()

但用这种方法，在编写派发 RPC 的代码时，仍然必须处理错误分支。

# let dispatch conn =
    match%bind Rpc.State_rpc.dispatch rpc conn () >>| ok_exn with
    | Ok (initial_state, updates, _) -> handle_state_changes initial_state updates
    | Error () -> failwith "this is not supposed to happen";;
val dispatch : Rpc.Connection.t -> unit Deferred.t = <fun>

另一种方法是为错误使用无人居住类型：

let rpc =
  Rpc.State_rpc.create
    ~name:"foo"
    ~version:1
    ~bin_query:[%bin_type_class: unit]
    ~bin_state:[%bin_type_class: int Map.M(String).t]
    ~bin_update:[%bin_type_class: int Map.M(String).t]
    ~bin_error:[%bin_type_class: Nothing.t]
    ()

现在，我们本质上禁止了 error 类型的使用。因此，派发函数只需要处理 Ok 分支。

# let dispatch conn =
    match%bind Rpc.State_rpc.dispatch rpc conn () >>| ok_exn with
    | Ok (initial_state, updates, _) -> handle_state_changes initial_state updates;;
val dispatch : Rpc.Connection.t -> unit Deferred.t = <fun>

这个例子好的一点在于，它展示了收窄可以应用到那些原本并不是为收窄而设计的代码上。

10.3 GADT 的限制（Limitations of GADTs）

希望到这里我们已经展示了 GADT 的效用，同时也展示了伴随而来的复杂性。最后一节会强调使用 GADT 时可能遇到的一些剩余困难，以及对应的绕行方法。

10.3.1 或模式（Or-Patterns）

GADT 和或模式（or-patterns）配合得不好。考虑下面这个类型，它表示我们可能用来获取某段数据的不同方式。

open Core
module Source_kind = struct
  type _ t =
    | Filename : string t
    | Host_and_port : Host_and_port.t t
    | Raw_data : string t
end

可以写一个函数，它接受一个 Source_kind.t 和对应来源，并把它打印出来。

# let source_to_sexp (type a) (kind : a Source_kind.t) (source : a) =
    match kind with
    | Filename -> String.sexp_of_t source
    | Host_and_port -> Host_and_port.sexp_of_t source
    | Raw_data -> String.sexp_of_t source;;
val source_to_sexp : 'a Source_kind.t -> 'a -> Sexp.t = <fun>

但如果注意到 Raw_data 和 Filename 的右侧相同，你可能会想把这些分支合并成一个或模式。可惜，这并不可行。

# let source_to_sexp (type a) (kind : a Source_kind.t) (source : a) =
    match kind with
    | Filename | Raw_data -> String.sexp_of_t source
    | Host_and_port -> Host_and_port.sexp_of_t source;;
Line 3, characters 47-53:
Error: This expression has type a but an expression was expected of type
         string

或模式有时也能工作，但前提是你没有使用模式匹配过程中发现的类型信息。下面是一个成功使用或模式的函数。

# let requires_io (type a) (kind : a Source_kind.t) =
    match kind with
    | Filename | Host_and_port -> true
    | Raw_data -> false;;
val requires_io : 'a Source_kind.t -> bool = <fun>

无论如何，缺少或模式支持确实烦人，但通常不是大问题。你可以把重复右侧的大部分内容抽成函数，然后在重复分支中分别调用，从而减少代码重复。

10.3.2 派生序列化器（Deriving Serializers）

第 21 章“使用 S 表达式进行数据序列化（Data Serialization with S-Expressions）”会更详细讨论，S 表达式是一种方便的数据格式，可用于表示结构化数据。我们通常不会手写序列化器和反序列化器，而是使用 ppx_sexp_value。这是一个语法扩展，可以基于给定类型的定义自动生成这些函数。

下面是一个例子：

# type position = { x: float; y: float } [@@deriving sexp];;
type position = { x : float; y : float; }
val position_of_sexp : Sexp.t -> position = <fun>
val sexp_of_position : position -> Sexp.t = <fun>
# sexp_of_position { x = 3.5; y = -2. };;
- : Sexp.t = ((x 3.5) (y -2))
# position_of_sexp (Sexp.of_string "((x 72) (y 1.2))");;
- : position = {x = 72.; y = 1.2}

虽然 [@@deriving sexp] 适用于大多数类型，但它并不总是能处理 GADT。

# type _ number_kind =
    | Int : int number_kind
    | Float : float number_kind
  [@@deriving sexp];;
Lines 1-4, characters 1-20:
Error: This expression has type int number_kind
       but an expression was expected of type a__007_ number_kind
       Type int is not compatible with type a__007_

这个错误消息很糟糕，但停下来想一想，这并不令人意外。number_kind_of_sexp 的类型到底该是什么？解析 "Int" 时，返回类型必须是 int number_kind；解析 "Float" 时，返回类型又必须是 float number_kind。这种“返回值类型依赖参数值”的关系，无法在 OCaml 类型系统中表达。

这个理由并不妨碍我们做序列化。事实上，只创建序列化器的 [@@deriving sexp_of] 可以正常工作。

# type _ number_kind =
   | Int : int number_kind
   | Float : float number_kind
  [@@deriving sexp_of];;
type _ number_kind = Int : int number_kind | Float : float number_kind
val sexp_of_number_kind :
  ('a__001_ -> Sexp.t) -> 'a__001_ number_kind -> Sexp.t = <fun>
# sexp_of_number_kind Int.sexp_of_t Int;;
- : Sexp.t = Int

也可以为 number_kind 构建反序列化器，但比较麻烦。首先需要一个类型，把 number_kind 打包起来，同时隐藏它的类型参数。这会成为解析器返回的值。

type packed_number_kind = P : _ number_kind -> packed_number_kind

接下来，需要创建一个非 GADT 版本的类型，并为它派生反序列化器。

type simple_number_kind = Int | Float [@@deriving of_sexp]

然后写一个函数，把非 GADT 类型转换成打包版本。

# let simple_number_kind_to_packed_number_kind kind :
    packed_number_kind
    =
    match kind with
    | Int -> P Int
    | Float -> P Float;;
val simple_number_kind_to_packed_number_kind :
  simple_number_kind -> packed_number_kind = <fun>

最后，把生成的 sexp 转换器和转换函数组合起来，得到完整的反序列化函数。

# let number_kind_of_sexp sexp =
    simple_number_kind_of_sexp sexp
    |> simple_number_kind_to_packed_number_kind;;
val number_kind_of_sexp : Sexp.t -> packed_number_kind = <fun>

下面展示这个函数的运行效果。

# List.map ~f:number_kind_of_sexp
    [ Sexp.of_string "Float"; Sexp.of_string "Int" ];;
- : packed_number_kind list = [P Float; P Int]

虽然这些都能做到，但确实很笨拙，而且需要一些令人不快的代码重复。