继续传递样式转换

Question

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

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 *)

有人知道如何使它正确，即有一个有效的类型添加，可能会改变Nat类型？

请注意，这个问题比Nat添加更为通用：对于更复杂的大小类型，同样的问题出现了。例如。对于大小的列表，所有基于累加器的函数如rev_append都很难输入。

Answer 1

此处的问题是，S i1的类型为(l s * m s) nat，而i的类型为m * n。因此，对add2的递归调用是错误类型的：add2期望其第一个参数的最右边索引与其第二个参数中最左边的一个匹配，m s与m绝对不同}}

因为您将值编码为差异，所以您可以轻松解决这个问题：您可以注意到(l * m) nat和(l s * m s) nat应该是相同的。你确实可以定义一个函数shift将一个函数转换为另一个函数，它基本上是一个身份函数：

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

然后，您可以在i的递归调用中调整add2的类型，以完成整个项目：

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。

继续传递样式转换

将一个非尾递归函数转换为尾递归函数的常用技术是在Continuation Passing Style中定义它：该函数采用额外的参数来描述如何处理返回值

我们可以将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)

Sledgehammer：Obj.magic

摆脱非尾递归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)

Nat类型与差异列表

1 个答案:

继续传递样式转换

Sledgehammer：Obj.magic