Types 具有差异列表的Nat类型

我将自然数编码为差异列表：

type z = Z
type +'a s = S

type _ nat =
  | Z : ('l * 'l) nat
  | S : ('l * 'm) nat -> ('l * 'm s) nat

这使我能够轻松地对加法进行编码：

let rec add : type l m n . (l*m) nat -> (m*n) nat -> (l*n) nat =
  fun i1 i2 ->  match i2 with
    | Z -> i1
    | S i -> S (add i1 i) (* OK *)

但是，以下变体不进行类型检查：

let rec add2 : type l m n . (l*m) nat -> (m*n) nat -> (l*n) nat =
  fun i1 i2 ->  match i2 with
    | Z -> i1
    | S i -> add2 (S i1) i    (* KO *)

let rec add2 : type l m n . (l*m) nat -> (m*n) nat -> (l*n) nat =
  fun i1 i2 ->  match i2 with
    | Z -> i1
    | S i -> add2 (S i1) (shift i)

是否有人知道如何使其正确，即有一个有效的类型添加，可能会更改Nat类型

---

请注意，这个问题比Nat添加的问题更一般：对于更复杂的大小类型，同样的问题也会出现。例如，对于大小列表，所有基于累加器的函数（如rev_append）都很难键入。

这里的问题是

S i1

具有type

（ls*ms）nat

，而

i

具有type

m*n

。因此，对

add2

的递归调用类型不正确：

add2

期望其第一个参数的最右索引与其第二个参数的最左索引匹配，

ms

与

m

完全不同

因为您将一个值编码为差异，所以可以很容易地解决这个问题：您可以注意到

（l*m）nat

和

（l s*ms）nat

应该是相同的。您确实可以定义一个函数，将一个函数转换为另一个函数，这基本上是一个标识函数：

let rec shift : type l m. (l*m) nat -> (l s * m s) nat = function
  | Z   -> Z
  | S i -> S (shift i)

然后，您可以在递归调用

add2

中调整

i

的类型，以进行整个类型检查：

let rec add2 : type l m n . (l*m) nat -> (m*n) nat -> (l*n) nat =
  fun i1 i2 ->  match i2 with
    | Z -> i1
    | S i -> add2 (S i1) i    (* KO *)

let rec add2 : type l m n . (l*m) nat -> (m*n) nat -> (l*n) nat =
  fun i1 i2 ->  match i2 with
    | Z -> i1
    | S i -> add2 (S i1) (shift i)

编辑：摆脱非尾部递归

shift

连续传递式变换 将非尾部递归函数转换为尾部递归函数的一种常见技术是在中定义它：该函数接受一个额外的参数，该参数描述如何处理返回值

我们可以将

shift

转换为尾部递归函数

shift3

，如下所示：

let shift3 : type l m. (l*m) nat -> (l s * m s) nat =
  let rec aux : type l m c. ((l s * m s) nat -> c) -> (l * m) nat -> c =
   fun k i -> match i with
     | Z -> k Z
     | S j -> aux (fun i -> k (S i)) j
  in fun i -> aux (fun x -> x) i

然后让我们定义

add3

：

let rec add3 : type l m n . (l*m) nat -> (m*n) nat -> (l*n) nat =
  fun i1 i2 ->  match i2 with
    | Z -> i1
    | S i -> add3 (S i1) (shift3 i)

大锤：目标魔法 摆脱非尾部递归的

shift

函数的一种（简单但肮脏）方法是将其替换为

Obj.magic

：事实上，正如前面提到的，我们的

shift

只不过是结构定义的标识函数

这导致我们：

let shift4 : type l m. (l*m) nat -> (l s * m s) nat = Obj.magic

let rec add4 : type l m n . (l*m) nat -> (m*n) nat -> (l*n) nat =
  fun i1 i2 ->  match i2 with
    | Z -> i1
    | S i -> add4 (S i1) (shift4 i)

---

谢谢你的回答，这很好地解释了打字问题。然而，这并不是很令人满意，因为

add2

的目标是tailcall recursive。这是以使用另一个非tailcall递归函数为代价实现的…@lavi请参阅我的编辑：我添加了

shift3

，其行为与

shift

类似，只是它是以连续传递样式定义的，因此它是递归的，并且在

Obj.magic

上有一个小段落。我宁愿坚持使用该语言的安全部分并使用CPS。是的，从技术上讲，

shift3

是尾部递归的。然而，由于堆栈消耗是相同的，并且持续增长，因此没有任何收益。所以我还是有点困惑。也许最好的解决方案是使用Obj.magic对差分不变量进行编码。。。但是，使用GADT并没有任何好处。在Ocaml出现之前，这种东西是用幻影类型编码的，所以不需要Obj.magic。我希望GADT能给我带来更干净的代码，但我现在不确定。