Encoding 可推断记录的编码

您可能知道，ocaml中的记录有些特殊，因为每个标签必须唯一地分配给一个标称记录类型，即，如果没有上下文，则无法键入以下函数：

let f r = r.x

适当的第一类记录（即行为类似于带标签的元组的东西）使用对象进行简单编码，例如

let f r = r#x 

当以正确的方式创建对象时（即没有自递归，没有变异），它们的行为就像记录一样

然而，我对这个解决方案有点不满意，原因有两个：

当使记录可更新时（即通过为每个标签l添加一个显式的“with_l”方法），类型有点过于松散（它应该与原始记录相同）。我承认，人们可以强制执行这种平等，但这仍然不方便

我怀疑OCaml编译器没有推断出这些记录实际上是不可变的：在函数中

设fr=r#x+r#x

编译器能够运行公共子表达式吗

出于这些原因，我想知道是否有更好的编码：

OCaml中是否存在另一种（除了使用对象之外）类型安全编码（例如使用多态变体）的可推断类型记录？

---

这种编码能避免上面提到的问题吗？

如果我理解正确，您正在寻找一种非常特殊的多态性。您希望编写一个适用于所有类型的函数，以便该类型是具有特定字段的记录。这听起来更像是C++风格中的语法多态性，而不是ML风格的语义多态性。如果我们稍微改变一下任务的措辞，通过理解字段访问只是字段投影函数的语法糖分，那么我们可以说，您想要编写一个在提供特定操作集的所有类型上都是多态的函数。OCaml可以使用以下机制之一捕获这种多态性：

函子

第一类模块

物体

我认为函子是显而易见的，所以我将展示一个具有第一类模块的示例。我们将编写一个函数

print\u student

，它将处理满足

student

签名的任何类型：

module type Student = sig
  type t
  val name : t -> string
  val age : t -> int
end


let print_student (type t)
    (module S : Student with type t = t) (s : t) =
  Printf.printf "%s %d" (S.name s) (S.age s)

print_student

函数的类型是

（类型为t='a）->'a->unit

。因此，它适用于满足

Student

接口的任何类型，因此它是多态的。这是一个非常强大的多态性，需要付出代价，在调用函数时需要显式地传递模块结构，因此它是System F风格的多态性。functor还要求您指定具体的模块结构。因此，这两种类型都不是可推断的（即，不是您正在寻找的隐式Hindley-Milner样式多态性）。对于后者，只有对象可以工作（也有模块化隐式，它放松了明确性要求，但它们仍然不在主干中，但它们实际上会满足您的要求）

使用对象样式行多态性，可以编写一个函数，该函数在符合某个签名的一组类型上具有多态性，并且可以从函数定义隐式推断该签名。然而，这种力量是有代价的。因为对象操作是用方法编码的，而方法只是在运行时动态分配的函数指针，所以不应该期望任何编译时优化。不可能对动态绑定的对象执行任何静态分析。当然，没有公共子表达式消除，也没有内联。对于函子和一级模块，可以使用

flamba

（参见

4.03.0+flambda

opam开关）在较新的编译器分支上进行优化。但是在常规的编译器安装中，不会执行内联

不同的方法 关于其他技术呢。首先，我们可以使用

camlp{4,5}

，或

ppx

，甚至

m4

和

cpp

对代码进行预处理，但这几乎不是惯用的方法，而且用处不大

另一种方法是，我们可以尝试找到合适的单态数据类型，而不是编写多态函数。直接方法是使用多态性变体列表，例如

type attributes = [`name of string | `age of int]
type student = attribute list  

事实上，我们甚至不需要预先指定所有这些类型，我们的函数只需要那些需要的字段，这是行多态的一种形式：

let rec name = function
  | [] -> raise Not_found
  | `name n -> n
  | _ :: student -> name student

这种编码的唯一问题是，您不能保证相同的命名属性可以出现一次，而且只能出现一次。所以有可能一个学生根本没有名字，或者，更糟糕的是，他可以有不止一个名字。根据您的问题领域，这是可以接受的

如果不是，那么我们可以使用GADT和可扩展变体来编码异构映射，即，将键映射到的关联数据结构 不同的类型（在常规（同质）映射或关联列表中，值类型是统一的）。如何构造这样的容器超出了答案的范围，但幸运的是，至少有两个可用的实现。一个是我个人使用的通用地图（

Univ\u-map

），由

Core

（实际上是

Core\u-kernel

）提供。它允许您指定两种异构映射，使用默认值和不使用默认值。前者对应一个带有可选字段的记录，后者对每个字段都有默认值，因此访问器是一个total函数。比如说,

 open Core_kernel.Std

 module Dict = Univ_map.With_default

 let name = Dict.Key.create ~name:"name" ~default:"Joe" sexp_of_string
 let age  = Dict.Key.create ~name:"age"  ~default:18 sexp_of_int

 let print student = 
   printf "%s %d" 
     (Dict.get student name) (Dict.get age name)

<x : int; y : float> Poly_record.t

您可以使用抽象类型隐藏您正在使用的通用映射，因为只有一个

Dict.t

可以跨不同的抽象使用，这可能会破坏模块化。异构映射实现的另一个示例来自。它不提供带有默认映射的

，但依赖性要小得多

当然，对于这种多余的情况，如果
 (** [copy_with r [(k1,v1);..;(kn,vn)]] is poly-record version of
     [{r with k1 = v1; ..; kn = vn}] *) 
 let copy_with r fields =
   let r = Hashtbl.copy r in
   List.iter (fun (k,v) -> Hashtbl.replace r (Btype.hash_variant k) v) fields

 (** [create [(k1,v1);..(kn,vn)]] is poly-record version of [{k1=v1;..;kn=vn}] *)
 let create fields = copy_with fields (Hashtbl.create (List.length fields))

<x : int; y : float> Poly_record.t

function `l_1 k -> k v_1 | `l_2 k -> k v_2 | ... | `l_n k -> k v_n

# let myRecord = (function `field1 k -> k 123 | `field2 k -> k "hello") ;;
    (* encodes { field1 = 123; field2 = "hello" } *)
val myRecord : [< `field1 of int -> 'a | `field2 of string -> 'a ] -> 'a = <fun>
# let getField1 r = r (`field1 (fun v -> v)) ;;
    (* fun r -> r.field1 *)
val getField1 : ([> `field1 of 'a -> 'a ] -> 'b) -> 'b = <fun>
# getField1 myRecord ;;
- : int = 123
# let getField2 r = r (`field2 (fun v -> v)) ;;
    (* fun r -> r.field2 *)
val getField2 : ([> `field2 of 'a -> 'a ] -> 'b) -> 'b = <fun>
# getField2 myRecord ;;
- : string = "hello"

let ref1 = ref 123
let ref2 = ref "hello"
let myRecord =
  function
  | `field1 k -> k !ref1
  | `field2 k -> k !ref2
  | `set_field1(v1, k) -> k (ref1 := v1)
  | `set_field2(v2, k) -> k (ref2 := v2)

let myRecord =
  let ref1 = ref 123 in
  let ref2 = ref "hello" in
  function
  | `field1 k -> k !ref1
  | `field2 k -> k !ref2
  | `set_field1(v1, k) -> k (ref1 := v1)
  | `set_field2(v2, k) -> k (ref2 := v2)