第 11 章：函子（Functors）

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

到目前为止，我们已经看到 OCaml 的模块扮演了重要但有限的角色。具体来说，我们使用模块把代码组织成具有指定接口的单元。但 OCaml 的模块系统能做的远不止这些，它是构建泛型代码和组织大规模系统的强大工具。这种能力很大一部分来自函子。

粗略地说，函子是从模块到模块的函数，可用于解决多种代码结构化问题，包括：

依赖注入（Dependency injection） : 让系统中某些组件的实现可以替换。当你想为了测试和模拟目的 mock 系统中的某些部分时，这尤其有用。

模块自动扩展（Autoextension of modules） : 函子提供了一种标准化方式，可以为已有模块扩展新功能。例如，可能想根据一个基础比较函数添加一批比较运算符。手工完成这件事需要为每个类型写大量重复代码，但函子允许你只写一次这套逻辑，然后应用到许多不同类型。

带状态模块的实例化（Instantiating modules with state） : 模块可以包含可变状态，这意味着你偶尔会想要同一个特定模块的多个实例，每个实例都有自己独立的可变状态。函子可以自动化构造这类模块。

这些其实只是函子的部分用途。本章不会试图为函子的所有用途提供例子，而是会提供一些例子，阐明为了有效使用函子而需要掌握的语言特性和设计模式。

11.1 一个平凡例子（A Trivial Example）

我们来创建一个函子，它接收一个包含单个整数变量 x 的模块，并返回一个新模块，其中 x 增加了 1。这个例子旨在走读函子的基本机制，尽管它并不是你在实践中会想做的事。

首先，定义一个签名，描述包含单个 int 类型值的模块：

# open Base;;
# module type X_int = sig val x : int end;;
module type X_int = sig val x : int end

现在可以定义函子。我们会同时使用 X_int 约束函子的参数，以及约束函子返回的模块：

# module Increment (M : X_int) : X_int = struct
    let x = M.x + 1
  end;;
module Increment : functor (M : X_int) -> X_int

立刻能注意到的一点是，函子在语法上比普通函数更重。首先，函子需要显式的模块类型标注，而普通函数不需要。从技术上说，只有输入类型是必需的；不过在实践中，通常也应该约束函子返回的模块，就像即使不是强制要求，也应该使用 mli 一样。

下面展示如果省略函子输出的模块类型会发生什么：

# module Increment (M : X_int) = struct
    let x = M.x + 1
  end;;
module Increment : functor (M : X_int) -> sig val x : int end

可以看到，输出的推断模块类型现在被显式写了出来，而不是引用具名签名 X_int。

可以用 Increment 定义新模块：

# module Three = struct let x = 3 end;;
module Three : sig val x : int end
# module Four = Increment(Three);;
module Four : sig val x : int end
# Four.x - Three.x;;
- : int = 1

在这个例子中，我们把 Increment 应用于一个签名与 X_int 完全相同的模块。但可以把 Increment 应用于任何满足 X_int 接口的模块，就像 ml 文件中的内容必须满足 mli 一样。这意味着模块类型可以省略模块中可用的一些信息，要么丢弃字段，要么把某些字段保留为抽象。下面是一个例子：

# module Three_and_more = struct
    let x = 3
    let y = "three"
  end;;
module Three_and_more : sig val x : int val y : string end
# module Four = Increment(Three_and_more);;
module Four : sig val x : int end

判断某个模块是否匹配给定签名的规则，在精神上类似面向对象语言中判断某个对象是否满足给定接口的规则。和面向对象语境一样，与目标签名不匹配的额外信息，在这里是变量 y，会被直接忽略。

11.2 更大的例子：区间计算（A Bigger Example: Computing with Intervals）

考虑一个更现实的函子用法：用于区间计算的库。区间是常见的计算对象，会在不同上下文和不同类型中出现。你可能需要处理浮点值区间、字符串区间或时间区间；在每种情况下，都想要类似操作：测试是否为空、检查是否包含某个值、求区间交集，等等。

可以用函子构建一个泛型区间库，它可用于任何在底层集合上支持全序的类型。

首先定义一个模块类型，捕获区间端点所需的信息。这个接口叫 Comparable，只包含两件事：一个比较函数，以及被比较值的类型。

# module type Comparable = sig
    type t
    val compare : t -> t -> int
  end;;
module type Comparable = sig type t val compare : t -> t -> int end

比较函数遵循这类函数的标准 OCaml 惯用法：如果两个元素相等，返回 0；如果第一个元素大于第二个元素，返回正数；如果第一个元素小于第二个元素，返回负数。因此，可以在 compare 之上重写标准比较函数。

compare x y < 0     (* x < y *)
compare x y = 0     (* x = y *)
compare x y > 0     (* x > y *)

这种惯用法有点历史包袱。如果 compare 返回一个包含小于、大于、相等三种情况的变体会更好。但它如今已经是成熟惯用法，不太可能改变。

下面是创建区间模块的函子。我们用一个变体类型表示区间，它要么是 Empty，要么是 Interval (x,y)，其中 x 和 y 是区间边界。除了类型之外，函子主体还包含若干用于与区间交互的有用原语实现：

# module Make_interval(Endpoint : Comparable) = struct

    type t = | Interval of Endpoint.t * Endpoint.t
             | Empty

    (** [create low high] creates a new interval from [low] to
        [high].  If [low > high], then the interval is empty *)
    let create low high =
      if Endpoint.compare low high > 0 then Empty
      else Interval (low,high)

    (** Returns true iff the interval is empty *)
    let is_empty = function
      | Empty -> true
      | Interval _ -> false

    (** [contains t x] returns true iff [x] is contained in the
        interval [t] *)
    let contains t x =
      match t with
      | Empty -> false
      | Interval (l,h) ->
        Endpoint.compare x l >= 0 && Endpoint.compare x h <= 0

    (** [intersect t1 t2] returns the intersection of the two input
        intervals *)
    let intersect t1 t2 =
      let min x y = if Endpoint.compare x y <= 0 then x else y in
      let max x y = if Endpoint.compare x y >= 0 then x else y in
      match t1,t2 with
      | Empty, _ | _, Empty -> Empty
      | Interval (l1,h1), Interval (l2,h2) ->
        create (max l1 l2) (min h1 h2)

  end;;
module Make_interval :
  functor (Endpoint : Comparable) ->
    sig
      type t = Interval of Endpoint.t * Endpoint.t | Empty
      val create : Endpoint.t -> Endpoint.t -> t
      val is_empty : t -> bool
      val contains : t -> Endpoint.t -> bool
      val intersect : t -> t -> t
    end

可以通过把函子应用于具有正确签名的模块来实例化它。在下面的代码中，我们不是先给模块命名再调用函子，而是把函子的输入作为匿名模块提供：

# module Int_interval =
    Make_interval(struct
      type t = int
      let compare = Int.compare
  end);;
module Int_interval :
  sig
    type t = Interval of int * int | Empty
    val create : int -> int -> t
    val is_empty : t -> bool
    val contains : t -> int -> bool
    val intersect : t -> t -> t
  end

如果函子的输入接口与所用库的标准保持一致，就不需要构造自定义模块再喂给函子。在这个例子中，可以直接使用 Base 提供的 Int 或 String 模块：

# module Int_interval = Make_interval(Int);;
module Int_interval :
  sig
    type t = Make_interval(Base.Int).t = Interval of int * int | Empty
    val create : int -> int -> t
    val is_empty : t -> bool
    val contains : t -> int -> bool
    val intersect : t -> t -> t
  end
# module String_interval = Make_interval(String);;
module String_interval :
  sig
    type t =
      Make_interval(Base.String).t =
        Interval of string * string
      | Empty
    val create : string -> string -> t
    val is_empty : t -> bool
    val contains : t -> string -> bool
    val intersect : t -> t -> t
  end

这能工作，是因为 Base 中的许多模块，包括 Int 和 String，都满足前面描述的 Comparable 签名的扩展版本。这样的标准化签名是好实践：它们既让函子更容易使用，也鼓励标准化，从而让代码库更容易导航。

可以像使用普通模块一样使用新定义的 Int_interval 模块：

# let i1 = Int_interval.create 3 8;;
val i1 : Int_interval.t = Int_interval.Interval (3, 8)
# let i2 = Int_interval.create 4 10;;
val i2 : Int_interval.t = Int_interval.Interval (4, 10)
# Int_interval.intersect i1 i2;;
- : Int_interval.t = Int_interval.Interval (4, 8)

这种设计让我们可以自由使用任何想要的比较函数来比较端点。例如，可以创建一种整数区间类型，其中比较顺序被反转：

# module Rev_int_interval =
    Make_interval(struct
      type t = int
      let compare x y = Int.compare y x
  end);;
module Rev_int_interval :
  sig
    type t = Interval of int * int | Empty
    val create : int -> int -> t
    val is_empty : t -> bool
    val contains : t -> int -> bool
    val intersect : t -> t -> t
  end

Rev_int_interval 的行为当然不同于 Int_interval：

# let interval = Int_interval.create 4 3;;
val interval : Int_interval.t = Int_interval.Empty
# let rev_interval = Rev_int_interval.create 4 3;;
val rev_interval : Rev_int_interval.t = Rev_int_interval.Interval (4, 3)

重要的是，Rev_int_interval.t 与 Int_interval.t 是不同类型，即使它们的物理表示相同。事实上，类型系统会阻止我们把它们混淆起来。

# Int_interval.contains rev_interval 3;;
Line 1, characters 23-35:
Error: This expression has type Rev_int_interval.t
       but an expression was expected of type Int_interval.t

这一点很重要，因为混淆这两种区间会是一种语义错误，而且这种错误很容易犯。函子能够生成新类型，是一个经常出现的有用技巧。

11.2.1 让函子变抽象（Making the Functor Abstract）

Make_interval 存在一个问题。我们写的代码依赖一个不变式：区间上界大于下界，但这个不变式可能被违反。create 函数会强制这个不变式；但因为 Int_interval.t 不是抽象的，所以可以绕过 create 函数：

# Int_interval.is_empty (* going through create *)
  (Int_interval.create 4 3);;
- : bool = true
# Int_interval.is_empty (* bypassing create *)
  (Int_interval.Interval (4,3));;
- : bool = false

为了让 Int_interval.t 抽象，需要用接口限制 Make_interval 的输出。下面是一个可用于此目的的显式接口：

# module type Interval_intf = sig
    type t
    type endpoint
    val create : endpoint -> endpoint -> t
    val is_empty : t -> bool
    val contains : t -> endpoint -> bool
    val intersect : t -> t -> t
  end;;
module type Interval_intf =
  sig
    type t
    type endpoint
    val create : endpoint -> endpoint -> t
    val is_empty : t -> bool
    val contains : t -> endpoint -> bool
    val intersect : t -> t -> t
  end

这个接口包含类型 endpoint，让我们可以指称端点类型。有了这个接口，就可以重新定义 Make_interval。注意，为了匹配 Interval_intf，我们在模块实现中添加了类型 endpoint：

# module Make_interval(Endpoint : Comparable) : Interval_intf = struct
    type endpoint = Endpoint.t
    type t = | Interval of Endpoint.t * Endpoint.t
             | Empty

    (** [create low high] creates a new interval from [low] to
        [high].  If [low > high], then the interval is empty *)
    let create low high =
      if Endpoint.compare low high > 0 then Empty
      else Interval (low,high)

    (** Returns true iff the interval is empty *)
    let is_empty = function
      | Empty -> true
      | Interval _ -> false

    (** [contains t x] returns true iff [x] is contained in the
        interval [t] *)
    let contains t x =
      match t with
      | Empty -> false
      | Interval (l,h) ->
        Endpoint.compare x l >= 0 && Endpoint.compare x h <= 0

    (** [intersect t1 t2] returns the intersection of the two input
        intervals *)
    let intersect t1 t2 =
      let min x y = if Endpoint.compare x y <= 0 then x else y in
      let max x y = if Endpoint.compare x y >= 0 then x else y in
      match t1,t2 with
      | Empty, _ | _, Empty -> Empty
      | Interval (l1,h1), Interval (l2,h2) ->
        create (max l1 l2) (min h1 h2)

  end;;
module Make_interval : functor (Endpoint : Comparable) -> Interval_intf

11.2.2 共享约束（Sharing Constraints）

得到的模块是抽象的，但不幸的是它太抽象了。具体来说，我们没有暴露 endpoint 类型，这意味着现在甚至无法构造区间：

# module Int_interval = Make_interval(Int);;
module Int_interval :
  sig
    type t = Make_interval(Base.Int).t
    type endpoint = Make_interval(Base.Int).endpoint
    val create : endpoint -> endpoint -> t
    val is_empty : t -> bool
    val contains : t -> endpoint -> bool
    val intersect : t -> t -> t
  end
# Int_interval.create 3 4;;
Line 1, characters 21-22:
Error: This expression has type int but an expression was expected of type
         Int_interval.endpoint

为了修复这个问题，需要暴露 endpoint 等于 Int.t 这个事实；更一般地说，等于 Endpoint.t，其中 Endpoint 是函子的参数。做到这一点的一种方式是使用共享约束（sharing constraint），它允许你告诉编译器暴露某个给定类型等于另一个类型这个事实。简单共享约束的语法如下：

<Module_type> with type <type> = <type'>

这个表达式的结果是一个新的签名，它被修改为暴露这样一个事实：模块类型内部定义的 type 等于在其外部定义的 type'。也可以对同一个签名应用多个共享约束：

<Module_type> with type <type1> = <type1'> and type <type2> = <type2'>

可以使用共享约束为整数区间创建一个 Interval_intf 的特化版本：

# module type Int_interval_intf =
  Interval_intf with type endpoint = int;;
module type Int_interval_intf =
  sig
    type t
    type endpoint = int
    val create : endpoint -> endpoint -> t
    val is_empty : t -> bool
    val contains : t -> endpoint -> bool
    val intersect : t -> t -> t
  end

也可以在函子语境中使用共享约束。最常见的用例是，你想暴露这样一个事实：函子生成模块中的某些类型与喂给函子的模块中的类型相关。

在这个例子中，我们想暴露新模块中的 endpoint 类型与函子参数模块 Endpoint 中的 Endpoint.t 类型相等。可以这样做：

# module Make_interval(Endpoint : Comparable)
    : (Interval_intf with type endpoint = Endpoint.t)
  = struct

    type endpoint = Endpoint.t
    type t = | Interval of Endpoint.t * Endpoint.t
             | Empty

    (** [create low high] creates a new interval from [low] to
        [high].  If [low > high], then the interval is empty *)
    let create low high =
      if Endpoint.compare low high > 0 then Empty
      else Interval (low,high)

    (** Returns true iff the interval is empty *)
    let is_empty = function
      | Empty -> true
      | Interval _ -> false

    (** [contains t x] returns true iff [x] is contained in the
        interval [t] *)
    let contains t x =
      match t with
      | Empty -> false
      | Interval (l,h) ->
        Endpoint.compare x l >= 0 && Endpoint.compare x h <= 0

    (** [intersect t1 t2] returns the intersection of the two input
        intervals *)
    let intersect t1 t2 =
      let min x y = if Endpoint.compare x y <= 0 then x else y in
      let max x y = if Endpoint.compare x y >= 0 then x else y in
      match t1,t2 with
      | Empty, _ | _, Empty -> Empty
      | Interval (l1,h1), Interval (l2,h2) ->
        create (max l1 l2) (min h1 h2)

  end;;
module Make_interval :
  functor (Endpoint : Comparable) ->
    sig
      type t
      type endpoint = Endpoint.t
      val create : endpoint -> endpoint -> t
      val is_empty : t -> bool
      val contains : t -> endpoint -> bool
      val intersect : t -> t -> t
    end

现在接口和之前一样，只是已知 endpoint 等于 Endpoint.t。由于这种类型相等性，我们又可以执行那些需要暴露 endpoint 的操作，例如构造区间：

# module Int_interval = Make_interval(Int);;
module Int_interval :
  sig
    type t = Make_interval(Base.Int).t
    type endpoint = int
    val create : endpoint -> endpoint -> t
    val is_empty : t -> bool
    val contains : t -> endpoint -> bool
    val intersect : t -> t -> t
  end
# let i = Int_interval.create 3 4;;
val i : Int_interval.t = <abstr>
# Int_interval.contains i 5;;
- : bool = false

11.2.3 破坏性替换（Destructive Substitution）

共享约束基本完成了工作，但也有一些缺点。具体来说，现在不得不带着无用的 endpoint 类型声明，它会弄乱接口和实现。更好的方案是修改 Interval_intf 签名，把其中所有出现 endpoint 的地方都替换为 Endpoint.t，并从签名中删除 endpoint 的定义。可以用所谓的破坏性替换（destructive substitution）来做到这一点。基本语法如下：

<Module_type> with type <type> := <type'>

它看起来像共享约束，只是用 := 而不是 =。下面展示如何把它用于 Make_interval。

# module type Int_interval_intf =
  Interval_intf with type endpoint := int;;
module type Int_interval_intf =
  sig
    type t
    val create : int -> int -> t
    val is_empty : t -> bool
    val contains : t -> int -> bool
    val intersect : t -> t -> t
  end

现在已经没有 endpoint 类型了：它的所有出现位置都被替换为 int。和共享约束一样，也可以在函子语境中使用它：

# module Make_interval(Endpoint : Comparable)
    : Interval_intf with type endpoint := Endpoint.t =
  struct

    type t = | Interval of Endpoint.t * Endpoint.t
             | Empty

    (** [create low high] creates a new interval from [low] to
        [high].  If [low > high], then the interval is empty *)
    let create low high =
      if Endpoint.compare low high > 0 then Empty
      else Interval (low,high)

    (** Returns true iff the interval is empty *)
    let is_empty = function
      | Empty -> true
      | Interval _ -> false

    (** [contains t x] returns true iff [x] is contained in the
        interval [t] *)
    let contains t x =
      match t with
      | Empty -> false
      | Interval (l,h) ->
        Endpoint.compare x l >= 0 && Endpoint.compare x h <= 0

    (** [intersect t1 t2] returns the intersection of the two input
        intervals *)
    let intersect t1 t2 =
      let min x y = if Endpoint.compare x y <= 0 then x else y in
      let max x y = if Endpoint.compare x y >= 0 then x else y in
      match t1,t2 with
      | Empty, _ | _, Empty -> Empty
      | Interval (l1,h1), Interval (l2,h2) ->
        create (max l1 l2) (min h1 h2)

  end;;
module Make_interval :
  functor (Endpoint : Comparable) ->
    sig
      type t
      val create : Endpoint.t -> Endpoint.t -> t
      val is_empty : t -> bool
      val contains : t -> Endpoint.t -> bool
      val intersect : t -> t -> t
    end

这个接口正是我们想要的：类型 t 是抽象的，而端点类型被暴露出来；因此可以使用创建函数创建 Int_interval.t 类型的值，但不能直接使用构造器并违反模块不变式。

# module Int_interval = Make_interval(Int);;
module Int_interval :
  sig
    type t = Make_interval(Base.Int).t
    val create : int -> int -> t
    val is_empty : t -> bool
    val contains : t -> int -> bool
    val intersect : t -> t -> t
  end
# Int_interval.is_empty
  (Int_interval.create 3 4);;
- : bool = false
# Int_interval.is_empty (Int_interval.Interval (4,3));;
Line 1, characters 24-45:
Error: Unbound constructor Int_interval.Interval

此外，endpoint 类型从接口中消失了，这意味着我们也不再需要在模块主体中定义 endpoint 类型别名。

值得注意的是，这个名字有些误导，因为破坏性替换并没有什么破坏性；它其实只是通过转换已有签名来创建新签名的一种方式。

11.2.4 使用多个接口（Using Multiple Interfaces）

我们可能还希望区间模块具备另一个特性：序列化，也就是能够把区间作为字节流读写。在这个例子中，我们会通过与 S 表达式相互转换来做到这一点。第 8 章“错误处理（Error Handling）”已经提到过 S 表达式。回顾一下，S 表达式本质上是原子为字符串的带括号表达式，也是 Base 中常用的序列化格式。下面是一个例子：

# Sexp.List [ Sexp.Atom "This"; Sexp.Atom "is"
  ; Sexp.List [Sexp.Atom "an"; Sexp.Atom "s-expression"]];;
- : Sexp.t = (This is (an s-expression))

Base 被设计成能很好地配合名为 ppx_sexp_conv 的语法扩展工作；它会为任何带有 [@@deriving sexp] 标注的类型生成 S 表达式转换函数。可以通过启用 ppx_jane，同时启用 ppx_sexp_conv 和一组其他有用扩展：

# #require "ppx_jane";;

现在，可以用 deriving 标注为给定类型创建 sexp 转换器。

# type some_type = int * string list [@@deriving sexp];;
type some_type = int * string list
val some_type_of_sexp : Sexp.t -> some_type = <fun>
val sexp_of_some_type : some_type -> Sexp.t = <fun>
# sexp_of_some_type (33, ["one"; "two"]);;
- : Sexp.t = (33 (one two))
# Core.Sexp.of_string "(44 (five six))" |> some_type_of_sexp;;
- : some_type = (44, ["five"; "six"])

第 21 章“使用 S 表达式进行数据序列化（Data Serialization With S Expressions）”会更详细讨论 S 表达式和 Sexplib；但现在先看看如果把 [@@deriving sexp] 声明附加到函子内 t 的定义上会发生什么：

# module Make_interval(Endpoint : Comparable)
    : (Interval_intf with type endpoint := Endpoint.t) = struct

    type t = | Interval of Endpoint.t * Endpoint.t
             | Empty
    [@@deriving sexp]

    (** [create low high] creates a new interval from [low] to
        [high].  If [low > high], then the interval is empty *)
    let create low high =
      if Endpoint.compare low high > 0 then Empty
      else Interval (low,high)

    (** Returns true iff the interval is empty *)
    let is_empty = function
      | Empty -> true
      | Interval _ -> false

    (** [contains t x] returns true iff [x] is contained in the
        interval [t] *)
    let contains t x =
      match t with
      | Empty -> false
      | Interval (l,h) ->
        Endpoint.compare x l >= 0 && Endpoint.compare x h <= 0

    (** [intersect t1 t2] returns the intersection of the two input
        intervals *)
    let intersect t1 t2 =
      let min x y = if Endpoint.compare x y <= 0 then x else y in
      let max x y = if Endpoint.compare x y >= 0 then x else y in
      match t1,t2 with
      | Empty, _ | _, Empty -> Empty
      | Interval (l1,h1), Interval (l2,h2) ->
        create (max l1 l2) (min h1 h2)

  end;;
Line 4, characters 28-38:
Error: Unbound value Endpoint.t_of_sexp

问题在于，[@@deriving sexp] 会添加定义 S 表达式转换器的代码，而这些代码假设 Endpoint 拥有适用于 Endpoint.t 的相应 sexp 转换函数。但我们只知道 Endpoint 满足 Comparable 接口，而这个接口没有说明任何 S 表达式相关内容。

幸好，Base 自带了一个正适合此目的的内置接口，叫 Sexpable.S，定义如下：

sig
  type t
  val sexp_of_t : t -> Sexp.t
  val t_of_sexp : Sexp.t -> t
end

可以修改 Make_interval，让它在输入和输出上都使用 Sexpable.S 接口。首先创建一个扩展版 Interval_intf 接口，其中包含来自 Sexpable.S 接口的函数。可以对 Sexpable.S 接口使用破坏性替换来做到这一点，以避免多个不同的 t 类型相互冲突：

# module type Interval_intf_with_sexp = sig
    include Interval_intf
    include Sexpable.S with type t := t
  end;;
module type Interval_intf_with_sexp =
  sig
    type t
    type endpoint
    val create : endpoint -> endpoint -> t
    val is_empty : t -> bool
    val contains : t -> endpoint -> bool
    val intersect : t -> t -> t
    val t_of_sexp : Sexp.t -> t
    val sexp_of_t : t -> Sexp.t
  end

等价地，可以在新模块中定义类型 t，并对所有包含进来的接口应用破坏性替换，包括 Interval_intf。如下例所示，在组合多个接口时，这样更干净，因为它正确反映出所有签名都被等价处理：

# module type Interval_intf_with_sexp = sig
    type t
    include Interval_intf with type t := t
    include Sexpable.S with type t := t
  end;;
module type Interval_intf_with_sexp =
  sig
    type t
    type endpoint
    val create : endpoint -> endpoint -> t
    val is_empty : t -> bool
    val contains : t -> endpoint -> bool
    val intersect : t -> t -> t
    val t_of_sexp : Sexp.t -> t
    val sexp_of_t : t -> Sexp.t
  end

现在可以写函子本身。这里我们很小心地覆盖了 sexp 转换器，以确保从 S 表达式读入时，数据结构的不变式仍然得到维护：

# module Make_interval(Endpoint : sig
      type t
      include Comparable with type t := t
      include Sexpable.S with type t := t
    end)
    : (Interval_intf_with_sexp with type endpoint := Endpoint.t)
  = struct

    type t = | Interval of Endpoint.t * Endpoint.t
             | Empty
    [@@deriving sexp]

    (** [create low high] creates a new interval from [low] to
        [high].  If [low > high], then the interval is empty *)
    let create low high =
      if Endpoint.compare low high > 0 then Empty
      else Interval (low,high)

    (* put a wrapper around the autogenerated [t_of_sexp] to enforce
       the invariants of the data structure *)
    let t_of_sexp sexp =
      match t_of_sexp sexp with
      | Empty -> Empty
      | Interval (x,y) -> create x y

    (** Returns true iff the interval is empty *)
    let is_empty = function
      | Empty -> true
      | Interval _ -> false

    (** [contains t x] returns true iff [x] is contained in the
        interval [t] *)
    let contains t x =
      match t with
      | Empty -> false
      | Interval (l,h) ->
        Endpoint.compare x l >= 0 && Endpoint.compare x h <= 0

    (** [intersect t1 t2] returns the intersection of the two input
        intervals *)
    let intersect t1 t2 =
      let min x y = if Endpoint.compare x y <= 0 then x else y in
      let max x y = if Endpoint.compare x y >= 0 then x else y in
      match t1,t2 with
      | Empty, _ | _, Empty -> Empty
      | Interval (l1,h1), Interval (l2,h2) ->
        create (max l1 l2) (min h1 h2)
  end;;
module Make_interval :
  functor
    (Endpoint : sig
                  type t
                  val compare : t -> t -> int
                  val t_of_sexp : Sexp.t -> t
                  val sexp_of_t : t -> Sexp.t
                end)
    ->
    sig
      type t
      val create : Endpoint.t -> Endpoint.t -> t
      val is_empty : t -> bool
      val contains : t -> Endpoint.t -> bool
      val intersect : t -> t -> t
      val t_of_sexp : Sexp.t -> t
      val sexp_of_t : t -> Sexp.t
    end

最后，可以按普通方式使用这个 sexp 转换器：

# module Int_interval = Make_interval(Int);;
module Int_interval :
  sig
    type t = Make_interval(Base.Int).t
    val create : int -> int -> t
    val is_empty : t -> bool
    val contains : t -> int -> bool
    val intersect : t -> t -> t
    val t_of_sexp : Sexp.t -> t
    val sexp_of_t : t -> Sexp.t
  end
# Int_interval.sexp_of_t (Int_interval.create 3 4);;
- : Sexp.t = (Interval 3 4)
# Int_interval.sexp_of_t (Int_interval.create 4 3);;
- : Sexp.t = Empty

11.3 扩展模块（Extending Modules）

函子的另一个常见用途，是以标准化方式为给定模块生成特定于类型的功能。来看它在函数式队列语境中如何工作。函数式队列只是 FIFO（first-in, first-out，先进先出）队列的函数式版本。作为函数式数据结构，对队列的操作会返回新队列，而不是修改传入的队列。

下面是这种模块的一个合理 mli：

type 'a t

val empty : 'a t

(** [enqueue q el] adds [el] to the back of [q] *)
val enqueue : 'a t -> 'a -> 'a t

(** [dequeue q] returns None if the [q] is empty, otherwise returns
    the first element of the queue and the remainder of the queue *)
val dequeue : 'a t -> ('a * 'a t) option

(** Folds over the queue, from front to back *)
val fold : 'a t -> init:'acc -> f:('acc -> 'a -> 'acc) -> 'acc

fold 函数的签名需要解释一下。它遵循第 4 章“列表与模式（Lists and Patterns）”中介绍的 List.fold 函数的同一模式。本质上，Fqueue.fold q ~init ~f 会从前到后遍历 q 的元素，从累加器 init 开始，并在遍历队列时使用 f 更新累加器值，最后返回计算结束时的累加器值。正如将看到的，fold 是一种相当强大的操作。

我们会用一个著名技巧实现 Fqueue：维护一个输入列表和一个输出列表，这样既能高效地入队到输入列表，也能从输出列表高效出队。如果尝试在输出列表为空时出队，输入列表会被反转并成为新的输出列表。下面是实现：

open Base

type 'a t = 'a list * 'a list

let empty = ([],[])

let enqueue (in_list, out_list) x =
  (x :: in_list,out_list)

let dequeue (in_list, out_list) =
  match out_list with
  | hd :: tl -> Some (hd, (in_list, tl))
  | [] ->
    match List.rev in_list with
    | [] -> None
    | hd :: tl -> Some (hd, ([], tl))

let fold (in_list, out_list) ~init ~f =
  let after_out = List.fold ~init ~f out_list in
  List.fold_right ~init:after_out ~f:(fun x acc -> f acc x) in_list

Fqueue 的一个问题是接口相当骨感。可能想要许多有用的辅助函数，但这里没有。对比之下，List 模块有 List.iter 这类函数，它会在每个元素上运行一个函数；还有 List.for_all，当且仅当给定谓词在列表每个元素上都求值为 true 时返回 true。这类辅助函数几乎会出现在每种容器类型上，而一遍又一遍实现它们是枯燥重复的工作。

事实证明，这些辅助函数中很多都可以从已经实现的 fold 函数机械派生出来。与其为每种新容器类型手写所有这些辅助函数，不如使用函子为任何拥有 fold 函数的容器添加这些功能。

我们会创建一个新模块 Foldable，自动为支持 fold 的容器添加辅助函数。可以看到，Foldable 包含一个模块签名 S，它定义了支持 folding 所需的签名；还包含一个函子 Extend，允许扩展任何匹配 Foldable.S 的模块：

open Base

module type S = sig
  type 'a t
  val fold : 'a t -> init:'acc -> f:('acc -> 'a -> 'acc) -> 'acc
end

module type Extension = sig
  type 'a t
  val iter    : 'a t -> f:('a -> unit) -> unit
  val length  : 'a t -> int
  val count   : 'a t -> f:('a -> bool) -> int
  val for_all : 'a t -> f:('a -> bool) -> bool
  val exists  : 'a t -> f:('a -> bool) -> bool
end

(* For extending a Foldable module *)
module Extend(Arg : S)
  : (Extension with type 'a t := 'a Arg.t) =
struct
  open Arg

  let iter t ~f =
    fold t ~init:() ~f:(fun () a -> f a)

  let length t =
    fold t ~init:0  ~f:(fun acc _ -> acc + 1)

  let count t ~f =
    fold t ~init:0  ~f:(fun count x -> count + if f x then 1 else 0)

  exception Short_circuit

  let for_all c ~f =
    try iter c ~f:(fun x -> if not (f x) then raise Short_circuit); true
    with Short_circuit -> false

  let exists c ~f =
    try iter c ~f:(fun x -> if f x then raise Short_circuit); false
    with Short_circuit -> true
end

现在可以把它应用到 Fqueue。可以为 Fqueue 的扩展版本创建如下接口：

type 'a t
include (module type of Fqueue) with type 'a t := 'a t
include Foldable.Extension with type 'a t := 'a t

为了应用函子，可以把 Fqueue 的定义放到名为 T 的子模块中，然后在 T 上调用 Foldable.Extend：

include Fqueue
include Foldable.Extend(Fqueue)

Base 自带了许多用于扩展模块的函子，它们遵循同一个基本模式，包括：

Container.Make：非常类似 Foldable.Extend。
Comparable.Make：添加依赖比较函数存在的功能支持，包括映射和集合这类容器支持。
Hashable.Make：添加基于哈希的数据结构支持，包括哈希表、哈希集合和哈希堆。
Monad.Make：用于所谓的单子式库，例如第 8 章“错误处理（Error Handling）”和第 17 章“使用 Async 的并发编程（Concurrent Programming with Async）”中讨论的那些库。这里，函子用于基于 bind 和 return 运算符提供一组标准辅助函数。

当你想把 Base 中常见的同类功能添加到自己的类型上时，这些函子很方便。

我们这里只覆盖了函子可能用途的一部分。函子确实是模块化代码的强大工具。代价是，与语言其他部分相比，函子语法更重；而且要有效使用它们，需要理解一些棘手问题，其中共享约束和破坏性替换尤其重要。

所有这些意味着，对于小而简单的程序，大量使用函子很可能是错误选择。但随着程序变得更复杂，并且需要更有效的模块化架构，函子就会变成非常有价值的工具。

11.1 一个平凡例子（A Trivial Example）​

11.2 更大的例子：区间计算（A Bigger Example: Computing with Intervals）​

11.2.1 让函子变抽象（Making the Functor Abstract）​

11.2.2 共享约束（Sharing Constraints）​

11.2.3 破坏性替换（Destructive Substitution）​

11.2.4 使用多个接口（Using Multiple Interfaces）​

11.3 扩展模块（Extending Modules）​