第 12 章：一等模块（First-Class Modules）
原文：Anil Madhavapeddy and Yaron Minsky, Real World OCaml: Functional Programming for the Masses, Second Edition, Chapter 12。维护者已确认本书为开源书籍，可翻译并发布用于学习研究。
可以把 OCaml 看作由两部分组成：一部分是关注值和类型的核心语言，另一部分是关注模块与模块签名的模块语言。这两个子语言是分层的：模块可以包含类型和值，但普通值不能包含模块或模块类型。因此，你不能直接定义一个值为模块的变量，也不能直接定义一个接收模块作为参数的函数。
OCaml 用一等模块（first-class modules）绕过了这种分层限制。一等模块是普通值，可以由普通模块创建，也可以再转换回普通模块。
一等模块是一种较高级的技术。要有效使用它，需要熟悉一些更高级的语言特性。不过它值得学习，因为把模块带进核心语言之后，表达能力会强很多，也更容易构建灵活、模块化的系统。
12.1 使用一等模块（Working with First-Class Modules）
我们先通过一些玩具例子介绍一等模块的基本机制。下一节会进入更真实的示例。
12.1.1 创建一等模块（Creating First-Class Modules）
考虑下面这个签名，它描述了一个包含单个整数变量的模块：
# open Base;;
# module type X_int = sig val x : int end;;
module type X_int = sig val x : int end
也可以创建一个匹配该签名的模块：
# module Three : X_int = struct let x = 3 end;;
module Three : X_int
# Three.x;;
- : int = 3
一等模块通过把一个模块和它满足的签名打包在一起来创建。语法使用 module 关键字：
(module <Module> : <Module_type>)
可以把 Three 转换成一等模块：
# let three = (module Three : X_int);;
val three : (module X_int) = <module>
12.1.2 类型推断与匿名模块（Inference and Anonymous Modules）
如果模块类型可以推断出来，那么构造一等模块时不一定需要显式写出模块类型。因此可以写成：
# module Four = struct let x = 4 end;;
module Four : sig val x : int end
# let numbers = [ three; (module Four) ];;
val numbers : (module X_int) list = [<module>; <module>]
也可以从匿名模块创建一等模块：
# let numbers = [three; (module struct let x = 4 end)];;
val numbers : (module X_int) list = [<module>; <module>]
12.1.3 解包一等模块（Unpacking First-Class Modules）
要访问一等模块中的内容，需要先把它解包成普通模块。这可以用 val 关键字完成，语法如下：
(val <first_class_module> : <Module_type>)
例如：
# module New_three = (val three : X_int);;
module New_three : X_int
# New_three.x;;
- : int = 3
12.1.4 操作一等模块的函数（Functions for Manipulating First-Class Modules）
也可以编写普通函数来消费和创建一等模块。下面定义了两个函数：to_int 把 (module X_int) 转换成 int；plus 返回两个 (module X_int) 的和：
# let to_int m =
let module M = (val m : X_int) in
M.x;;
val to_int : (module X_int) -> int = <fun>
# let plus m1 m2 =
(module struct
let x = to_int m1 + to_int m2
end : X_int);;
val plus : (module X_int) -> (module X_int) -> (module X_int) = <fun>
还可以用模式匹配来解包一等模块，这让 to_int 可以写得更简洁：
# let to_int (module M : X_int) = M.x;;
val to_int : (module X_int) -> int = <fun>
有了这些函数，就可以更自然地处理 (module X_int) 类型的值，享受核心语言的简洁和便利：
# let six = plus three three;;
val six : (module X_int) = <module>
# to_int (List.fold ~init:six ~f:plus [three;three]);;
- : int = 12
12.1.5 更丰富的一等模块（Richer First-Class Modules）
一等模块不只可以包含 int 这样简单的值，也可以包含类型和函数。下面这个接口包含一个类型，以及一个对应的 bump 操作：它接收该类型的值并产生一个新值。
# module type Bumpable = sig
type t
val bump : t -> t
end;;
module type Bumpable = sig type t val bump : t -> t end
可以创建多个底层类型不同的模块实例：
# module Int_bumper = struct
type t = int
let bump n = n + 1
end;;
module Int_bumper : sig type t = int val bump : t -> t end
# module Float_bumper = struct
type t = float
let bump n = n +. 1.
end;;
module Float_bumper : sig type t = float val bump : t -> t end
然后把它们转换成一等模块：
# let int_bumper = (module Int_bumper : Bumpable);;
val int_bumper : (module Bumpable) = <module>
12.1.6 暴露类型（Exposing Types）
现在还不能对 int_bumper 做太多事情，因为它是完全抽象的。我们无法利用其中类型实际是 int 这一事实，因此既不能构造 Bumper.t 类型的值，也很难真正使用它。
# let (module Bumper) = int_bumper in
Bumper.bump 3;;
Line 2, characters 15-16:
Error: This expression has type int but an expression was expected of type
Bumper.t
为了让 int_bumper 可用，需要暴露 Bumpable.t 实际等于 int。下面对 int_bumper 做这件事，同时也给出 float_bumper 的对应定义：
# let int_bumper = (module Int_bumper : Bumpable with type t = int);;
val int_bumper : (module Bumpable with type t = int) = <module>
# let float_bumper = (module Float_bumper : Bumpable with type t = float);;
val float_bumper : (module Bumpable with type t = float) = <module>
加入共享约束后，类型 t 被暴露出来，于是可以实际使用模块中的值。
# let (module Bumper) = int_bumper in
Bumper.bump 3;;
- : int = 4
# let (module Bumper) = float_bumper in
Bumper.bump 3.5;;
- : float = 4.5
也可以以多态方式使用这些一等模块。下面这个函数接收两个参数：一个 Bumpable 模块，以及一个元素类型与该模块中类型 t 相同的列表。
# let bump_list
(type a)
(module Bumper : Bumpable with type t = a)
(l: a list)
=
List.map ~f:Bumper.bump l;;
val bump_list : (module Bumpable with type t = 'a) -> 'a list -> 'a list =
<fun>
在这个例子中，a 是局部抽象类型（locally abstract type）。对任意函数，都可以声明形如 (type a) 的伪参数，引入名为 a 的全新类型。这个类型在函数内部像抽象类型一样工作。上面的例子中，局部抽象类型被用作共享约束的一部分，把 B.t 的类型和传入列表元素的类型绑定在一起。
得到的函数同时对列表元素类型和 Bumpable.t 的类型多态。可以看到它如何运行：
# bump_list int_bumper [1;2;3];;
- : int list = [2; 3; 4]
# bump_list float_bumper [1.5;2.5;3.5];;
- : float list = [2.5; 3.5; 4.5]
多态的一等模块很重要，因为它们允许你把一等模块关联的类型，与正在处理的其他值的类型连接起来。
12.1.6.1 局部抽象类型补充（More on Locally Abstract Types）
局部抽象类型的一个关键性质是：在定义它们的函数内部，它们会被当作抽象类型处理；但从外部看，整个函数仍然是多态的。考虑这个例子：
# let wrap_in_list (type a) (x:a) = [x];;
val wrap_in_list : 'a -> 'a list = <fun>
这里对类型 a 的使用方式与抽象类型兼容，但推断出的函数类型是多态的。
另一方面，如果试图把类型 a 当作某个具体类型来使用，比如 int，编译器就会报错。
# let double_int (type a) (x:a) = x + x;;
Line 1, characters 33-34:
Error: This expression has type a but an expression was expected of type int
局部抽象类型的一种常见用途，是创建一个新类型，并把它用于构造模块。下面展示如何用这种方式创建一个新的一等模块：
# module type Comparable = sig
type t
val compare : t -> t -> int
end;;
module type Comparable = sig type t val compare : t -> t -> int end
# let create_comparable (type a) compare =
(module struct
type t = a
let compare = compare
end : Comparable with type t = a);;
val create_comparable :
('a -> 'a -> int) -> (module Comparable with type t = 'a) = <fun>
# create_comparable Int.compare;;
- : (module Comparable with type t = int) = <module>
# create_comparable Float.compare;;
- : (module Comparable with type t = float) = <module>
这个技巧并不限于一等模块。例如，可以用同样方法构造一个局部模块，然后把它传给函子。
12.2 示例：查询处理框架（Example: A Query-Handling Framework）
现在来看一个更完整、更真实的一等模块示例。具体来说，我们要实现一个响应用户查询的系统。
这个系统会使用 S 表达式（s-expressions）来格式化查询、响应，以及查询处理器的配置。S 表达式是一种简单、灵活、可读的序列化格式，常用于 Base 及相关库。现在只需把它看作括号平衡的表达式，其中原子值是字符串，例如 (this (is an) (s expression))。第 21 章会更详细讨论 S 表达式。
下面是实现查询响应系统的模块签名。这里使用 Base 的 Sexp 模块处理 S 表达式。注意，也完全可以使用 JSON 这样的其他序列化格式，第 19 章会讨论 JSON。
module type Query_handler = sig
(** Configuration for a query handler *)
type config
val sexp_of_config : config -> Sexp.t
val config_of_sexp : Sexp.t -> config
(** The name of the query-handling service *)
val name : string
(** The state of the query handler *)
type t
(** Creates a new query handler from a config *)
val create : config -> t
(** Evaluate a given query, where both input and output are
s-expressions *)
val eval : t -> Sexp.t -> Sexp.t Or_error.t
end;;
手写 S 表达式转换器很乏味，也容易出错。幸运的是，我们有替代方案。ppx_sexp_conv 是一种语法扩展，可以根据类型定义自动生成 S 表达式转换器。这里通过启用 ppx_jane 来启用它；ppx_jane 会带来更大的一组语法扩展。
# #require "ppx_jane";;
下面是这个扩展的例子。注意，需要加上 [@@deriving sexp] 标注来触发转换器生成。
# type u = { a: int; b: float } [@@deriving sexp];;
type u = { a : int; b : float; }
val u_of_sexp : Sexp.t -> u = <fun>
val sexp_of_u : u -> Sexp.t = <fun>
# sexp_of_u {a=3;b=7.};;
- : Sexp.t = ((a 3) (b 7))
# u_of_sexp (Core.Sexp.of_string "((a 43) (b 3.4))");;
- : u = {a = 43; b = 3.4}
同样的标注也可以放在签名中，用来添加合适的类型签名。
# module type M = sig type t [@@deriving sexp] end;;
module type M =
sig type t val t_of_sexp : Sexp.t -> t val sexp_of_t : t -> Sexp.t end
12.2.1 实现查询处理器（Implementing a Query Handler）
现在可以构造一个满足 Query_handler 接口的查询处理器示例。先从一个产生唯一整数 ID 的处理器开始。它内部维护一个计数器，每次请求新值时就递增一次。这个查询的输入只是平凡的 S 表达式 ()，也就是 Sexp.unit。
module Unique = struct
type config = int [@@deriving sexp]
type t = { mutable next_id: int }
let name = "unique"
let create start_at = { next_id = start_at }
let eval t sexp =
match Or_error.try_with (fun () -> unit_of_sexp sexp) with
| Error _ as err -> err
| Ok () ->
let response = Ok (Int.sexp_of_t t.next_id) in
t.next_id <- t.next_id + 1;
response
end;;
可以用这个模块创建 Unique 查询处理器的一个实例，并直接与它交互：
# let unique = Unique.create 0;;
val unique : Unique.t = {Unique.next_id = 0}
# Unique.eval unique (Sexp.List []);;
- : (Sexp.t, Error.t) result = Ok 0
# Unique.eval unique (Sexp.List []);;
- : (Sexp.t, Error.t) result = Ok 1
另一个例子是列目录的查询处理器。这里的配置是默认目录，相对路径会在这个目录中解释。
# #require "core_unix.sys_unix";;
module List_dir = struct
type config = string [@@deriving sexp]
type t = { cwd: string }
(** [is_abs p] Returns true if [p] is an absolute path *)
let is_abs p =
String.length p > 0 && Char.(=) p.[0] '/'
let name = "ls"
let create cwd = { cwd }
let eval t sexp =
match Or_error.try_with (fun () -> string_of_sexp sexp) with
| Error _ as err -> err
| Ok dir ->
let dir =
if is_abs dir then dir
else Core.Filename.concat t.cwd dir
in
Ok (Array.sexp_of_t String.sexp_of_t (Sys_unix.readdir dir))
end;;
同样，可以创建这个查询处理器的实例并直接交互：
# let list_dir = List_dir.create "/var";;
val list_dir : List_dir.t = {List_dir.cwd = "/var"}
# List_dir.eval list_dir (sexp_of_string ".");;
- : (Sexp.t, Error.t) result =
Ok
(yp networkd install empty ma mail spool jabberd vm msgs audit root lib db
at log folders netboot run rpc tmp backups agentx rwho)
# List_dir.eval list_dir (sexp_of_string "yp");;
- : (Sexp.t, Error.t) result = Ok (binding)
12.2.2 分派到多个查询处理器（Dispatching to Multiple Query Handlers）
如果想把查询分派给任意一组处理器中的某一个，该怎么办？理想情况下，我们希望像传入列表这样的简单数据结构一样传入这些处理器。只靠模块和函子做到这件事比较笨拙，但用一等模块就很自然。首先，需要创建一个签名，把 Query_handler 模块和一个已实例化的查询处理器组合起来：
# module type Query_handler_instance = sig
module Query_handler : Query_handler
val this : Query_handler.t
end;;
module type Query_handler_instance =
sig module Query_handler : Query_handler val this : Query_handler.t end
有了这个签名，就可以创建一个一等模块，把某个查询实例以及处理该查询所需的匹配操作都封装起来。
可以这样创建一个实例：
# let unique_instance =
(module struct
module Query_handler = Unique
let this = Unique.create 0
end : Query_handler_instance);;
val unique_instance : (module Query_handler_instance) = <module>
以这种方式构造实例略显冗长，但可以写一个函数消除大部分样板代码。注意这里再次使用了局部抽象类型。
# let build_instance
(type a)
(module Q : Query_handler with type config = a)
config
=
(module struct
module Query_handler = Q
let this = Q.create config
end : Query_handler_instance);;
val build_instance :
(module Query_handler with type config = 'a) ->
'a -> (module Query_handler_instance) = <fun>
使用 build_instance 后，构造新实例就变成了一行：
# let unique_instance = build_instance (module Unique) 0;;
val unique_instance : (module Query_handler_instance) = <module>
# let list_dir_instance = build_instance (module List_dir) "/var";;
val list_dir_instance : (module Query_handler_instance) = <module>
现在可以编写代码，把查询分派给查询处理器实例列表中的某一个。我们假设查询的形状如下：
(query-name query)
其中 query-name 是用来决定分派到哪个查询处理器的名称，query 是查询主体。
首先需要一个函数，它接收查询处理器实例列表，并由此构造一张分派表：
# let build_dispatch_table handlers =
let table = Hashtbl.create (module String) in
List.iter handlers
~f:(fun ((module I : Query_handler_instance) as instance) ->
Hashtbl.set table ~key:I.Query_handler.name ~data:instance);
table;;
val build_dispatch_table :
(module Query_handler_instance) list ->
(string, (module Query_handler_instance)) Hashtbl.Poly.t = <fun>
接下来，需要一个函数使用分派表分派到处理器：
# let dispatch dispatch_table name_and_query =
match name_and_query with
| Sexp.List [Sexp.Atom name; query] ->
begin match Hashtbl.find dispatch_table name with
| None ->
Or_error.error "Could not find matching handler"
name String.sexp_of_t
| Some (module I : Query_handler_instance) ->
I.Query_handler.eval I.this query
end
| _ ->
Or_error.error_string "malformed query";;
val dispatch :
(string, (module Query_handler_instance)) Hashtbl.Poly.t ->
Sexp.t -> Sexp.t Or_error.t = <fun>
这个函数通过把实例解包成模块 I 来与实例交互，然后把查询处理器实例 I.this 和关联模块 I.Query_handler 配合起来使用。
把模块和值绑在一起，在许多方面让人想起面向对象语言。一个关键差异在于，一等模块允许你打包的不只是函数或方法。正如已经看到的，也可以包含类型，甚至包含模块。这里的用法还比较小，但这种额外能力允许你构建更复杂的组件，其中包含多个相互依赖的类型和值。
可以通过添加命令行界面，把这段代码变成一个完整的可运行示例：
# open Stdio;;
# let rec cli dispatch_table =
printf ">>> %!";
let result =
match In_channel.(input_line stdin) with
| None -> `Stop
| Some line ->
match Or_error.try_with (fun () ->
Core.Sexp.of_string line)
with
| Error e -> `Continue (Error.to_string_hum e)
| Ok (Sexp.Atom "quit") -> `Stop
| Ok query ->
begin match dispatch dispatch_table query with
| Error e -> `Continue (Error.to_string_hum e)
| Ok s -> `Continue (Sexp.to_string_hum s)
end;
in
match result with
| `Stop -> ()
| `Continue msg ->
printf "%s\n%!" msg;
cli dispatch_table;;
val cli : (string, (module Query_handler_instance)) Hashtbl.Poly.t -> unit =
<fun>
我们会把上面的代码放进一个文件中，并用一个独立程序运行这个命令行界面。下面的代码用于启动界面：
let () =
cli (build_dispatch_table [unique_instance; list_dir_instance])
下面是这个程序的一次会话示例：
$ dune exec -- ./query_handler.exe
>>> (unique ())
0
>>> (unique ())
1
>>> (ls .)
(agentx at audit backups db empty folders jabberd lib log mail msgs named
netboot pgsql_socket_alt root rpc run rwho spool tmp vm yp)
>>> (ls vm)
(sleepimage swapfile0 swapfile1 swapfile2 swapfile3 swapfile4 swapfile5
swapfile6)
12.2.3 加载和卸载查询处理器（Loading and Unloading Query Handlers）
一等模块的优势之一，是它们提供了很强的动态性和灵活性。例如，要修改设计以允许查询处理器在运行时加载和卸载，是一件相当简单的事。
我们会通过创建一个查询处理器来完成这件事，它的职责是控制活跃查询处理器集合。这个模块叫作 Loader，它的配置是一组已知的 Query_handler 模块。下面是基本类型：
module Loader = struct
type config = (module Query_handler) list [@sexp.opaque]
[@@deriving sexp]
type t = { known : (module Query_handler) String.Table.t
; active : (module Query_handler_instance) String.Table.t
}
let name = "loader"
注意，Loader.t 有两张表：一张包含已知查询处理器模块，另一张包含活跃查询处理器实例。Loader.t 负责响应用户查询：创建新实例并加入表中，也负责移除实例。
接下来，需要一个创建 Loader.t 的函数。这个函数需要已知查询处理器模块列表。注意，活跃模块表一开始是空的：
let create known_list =
let active = String.Table.create () in
let known = String.Table.create () in
List.iter known_list
~f:(fun ((module Q : Query_handler) as q) ->
Hashtbl.set known ~key:Q.name ~data:q);
{ known; active }
现在可以编写操作活跃查询处理器表的函数。先从加载实例的函数开始。注意它接收查询处理器的名称，以及用于实例化该处理器的配置，配置采用 S 表达式形式。这些信息用于创建类型为 (module Query_handler_instance) 的一等模块，然后把它加入活跃表。
let load t handler_name config =
if Hashtbl.mem t.active handler_name then
Or_error.error "Can't re-register an active handler"
handler_name String.sexp_of_t
else
match Hashtbl.find t.known handler_name with
| None ->
Or_error.error "Unknown handler" handler_name String.sexp_of_t
| Some (module Q : Query_handler) ->
let instance =
(module struct
module Query_handler = Q
let this = Q.create (Q.config_of_sexp config)
end : Query_handler_instance)
in
Hashtbl.set t.active ~key:handler_name ~data:instance;
Ok Sexp.unit
由于 load 函数会拒绝再次加载已经活跃的处理器，我们还需要卸载处理器的能力。注意，这个处理器明确拒绝卸载自己：
let unload t handler_name =
if not (Hashtbl.mem t.active handler_name) then
Or_error.error "Handler not active" handler_name String.sexp_of_t
else if String.(=) handler_name name then
Or_error.error_string "It's unwise to unload yourself"
else (
Hashtbl.remove t.active handler_name;
Ok Sexp.unit
)
最后，需要实现 eval 函数，它决定呈现给用户的查询接口。我们会通过创建一个变体类型，并使用为该类型生成的 S 表达式转换器来解析用户查询。
type request =
| Load of string * Sexp.t
| Unload of string
| Known_services
| Active_services
[@@deriving sexp]
eval 本身相当直接，它会分派到合适的函数来响应每种查询。注意，这里写 [%sexp_of: string list] 来自动生成把字符串列表转换成 S 表达式的函数，这和第 21 章讨论的 S 表达式序列化有关。
这个函数结束了 Loader 模块的定义：
let eval t sexp =
match Or_error.try_with (fun () -> request_of_sexp sexp) with
| Error _ as err -> err
| Ok resp ->
match resp with
| Load (name,config) -> load t name config
| Unload name -> unload t name
| Known_services ->
Ok ([%sexp_of: string list] (Hashtbl.keys t.known))
| Active_services ->
Ok ([%sexp_of: string list] (Hashtbl.keys t.active))
end
最后，可以把所有部分和命令行界面组合起来。先创建一个 loader 查询处理器实例，并把这个实例加入 loader 的活跃表。然后启动命令行界面，并传入活跃表。
let () =
let loader = Loader.create [(module Unique); (module List_dir)] in
let loader_instance =
(module struct
module Query_handler = Loader
let this = loader
end : Query_handler_instance)
in
Hashtbl.set loader.Loader.active
~key:Loader.name ~data:loader_instance;
cli loader.active
最终的命令行界面行为符合预期：开始时没有可用的查询处理器，但可以加载和卸载它们。下面是一段运行示例。可以看到，起初只有 loader 自己是活跃处理器。
$ dune exec -- ./query_handler_loader.exe
>>> (loader known_services)
(ls unique)
>>> (loader active_services)
(loader)
任何尝试使用非活跃查询处理器的操作都会失败：
>>> (ls .)
Could not find matching handler: ls
不过，可以用自己选择的配置加载 ls 处理器，此后它就可以使用。卸载后，它又不可用，并且可以用不同配置重新加载。
>>> (loader (load ls /var))
()
>>> (ls .)
(agentx at audit backups db empty folders jabberd lib log mail msgs named
netboot pgsql_socket_alt root rpc run rwho spool tmp vm yp)
>>> (loader (unload ls))
()
>>> (ls .)
Could not find matching handler: ls
值得注意的是，loader 不能被加载，因为它不在已知处理器列表中；它也不能被卸载：
>>> (loader (unload loader))
It's unwise to unload yourself
虽然这里不会描述细节，但可以用 OCaml 的动态链接能力把这种动态性进一步推进。动态链接允许你编译新代码，并把它链接到正在运行的程序中。这个流程可以用 ocaml_plugin 这样的库自动化；它可以通过 OPAM 安装，并且会处理设置动态链接所需的大部分工作。
12.3 不使用一等模块（Living Without First-Class Modules）
值得注意的是，大多数可以用一等模块完成的设计，都可以在一定程度的笨拙中不用一等模块模拟出来。例如，可以用下面这些类型重写查询处理器示例：
# type query_handler_instance =
{ name : string
; eval : Sexp.t -> Sexp.t Or_error.t };;
type query_handler_instance = {
name : string;
eval : Sexp.t -> Sexp.t Or_error.t;
}
# type query_handler = Sexp.t -> query_handler_instance;;
type query_handler = Sexp.t -> query_handler_instance
这里的思路是，把相关对象的真实类型隐藏在闭包中存储的函数背后。因此，可以像下面这样把 Unique 查询处理器放进这个框架：
# let unique_handler config_sexp =
let config = Unique.config_of_sexp config_sexp in
let unique = Unique.create config in
{ name = Unique.name
; eval = (fun config -> Unique.eval unique config)
};;
val unique_handler : Sexp.t -> query_handler_instance = <fun>
对于这个规模的例子，前一种方法完全合理，一等模块并不是必需的。但当需要隐藏在闭包背后的功能越多、相关类型之间的关系越复杂时，这种做法就会越笨拙，而使用一等模块也就越合适。