两个具有相同类型的值的相关模式匹配

时间：2017-07-23 10:33:26

标签： pattern-matching coq dependent-type convoy-pattern

我们将使用有限集的标准定义：

Inductive fin : nat -> Set :=
| F1 : forall {n : nat}, fin (S n)
| FS : forall {n : nat}, fin n -> fin (S n).

我们假设我们有一些P : forall {m : nat} (x y : fin m) : Set（ 重要的是P的两个参数都属于同一类型。对于 演示目的，让P只是：

Definition P {m : nat} (x y : fin m) := {x = y} + {x <> y}.

现在，我们想编写一个比较两个数字的自定义函数：

Fixpoint feq_dec {m : nat} (x y : fin m) : P x y.

这个想法很简单：我们匹配x和y，x = F1，y = F1我们 我们递归调用x = FS x'，y = FS y'，平凡地返回相等 x'和y'的程序，对于其他我们可以轻易返回的情况 不等式。

将这个想法直接翻译成Coq显然失败了：

refine (
  match x, y return P x y with
  | F1 _, F1 _ => _
  | FS _ x', F1 _ => _
  | F1 _, FS _ y' => _
  | FS _ x', FS _ y' => _
  end
).

(*
 * The term "y0" has type "fin n0" while it is expected to have type "fin n".
 *)

在x和y的匹配期间，我们会丢失类型信息，因此我们无法将其应用于P。 传递类型相等证明的标准技巧在这里没有用处：

refine (
  match x in fin mx, y in fin my return mx = my -> P x y with
  | F1 _, F1 _ => _
  | FS _ x', F1 _ => _
  | F1 _, FS _ y' => _
  | FS _ x', FS _ y' => _
  end eq_refl
).

(*
 * The term "y0" has type "fin my" while it is expected to have type "fin mx".
 *)

所以，也许我们可以使用相等的证明来构建x具有相同的类型 y？

Definition fcast {m1 m2 : nat} (Heq : m1 = m2) (x : fin m1) : fin m2.
Proof.
  rewrite <- Heq.
  apply x.
Defined.

我们还需要能够在以后摆脱演员阵容。但是，我注意到了 fcast eq_refl x = x是不够的，因为我们需要将其与之合作 任意等价证明。我找到了一种叫做UIP的东西 我需要什么。

Require Import Coq.Program.Program.

Lemma fcast_void {m : nat} : forall (x : fin m) (H : m = m),
  fcast H x = x.
Proof.
  intros.
  rewrite -> (UIP nat m m H eq_refl).
  trivial.
Defined.

现在我们已准备好完成整个定义：

refine (
  match x in fin mx, y in fin my
  return forall (Hmx : m = mx) (Hmy : mx = my), P (fcast Hmy x) y with
  | F1 _, F1 _ => fun Hmx Hmy => _
  | FS _ x', F1 _ => fun Hmx Hmy => _
  | F1 _, FS _ y' => fun Hmx Hmy => _
  | FS _ x', FS _ y' => fun Hmx Hmy => _
  end eq_refl eq_refl
); inversion Hmy; subst; rewrite fcast_void.
- left. reflexivity.
- right. intro Contra. inversion Contra.
- right. intro Contra. inversion Contra.
- destruct (feq_dec _ x' y') as [Heq | Hneq].
  + left. apply f_equal. apply Heq.
  + right. intro Contra. dependent destruction Contra. apply Hneq. reflexivity.
Defined.

它经历了！但是，它没有评估任何有用的值。例如 以下产生一个带有五个嵌套匹配而不是简单值的术语 （in_right或in_left）。我怀疑问题出在我的UIP公理上 使用

Compute (@feq_dec 5 (FS F1) (FS F1)).

所以最后，我提出的定义几乎没用。 我还尝试使用护航模式进行嵌套匹配，而不是在匹配两个值 同时我遇到了同样的障碍：只要我对第二个值进行匹配，P就不再适用了它。我可以用其他方式吗？

2 个答案:

答案 0 :(得分：2)

这是一个已知问题，在大多数情况下，你会更好地使用基础nat上的相等性，然后获利而不是to_nat函数是单射的：

From mathcomp Require Import all_ssreflect.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Require Import PeanoNat Fin.

Fixpoint to_nat m (x : t m) :=
  match x with
  | F1 _   => 0
  | FS _ x => (to_nat x).+1
  end.

Lemma to_nat_inj m : injective (@to_nat m).
Proof.
elim: m / => /= [|m t iht y].
  exact: (caseS (fun n (y : t n.+1) => _)).
move: m y t iht.
by apply: (caseS (fun n (y : t n.+1) => _)) => //= n p t iht [] /iht ->.
Qed.

Lemma feq_dec {m : nat} (x y : t m) : {x = y} + {x <> y}.
Proof.
have [heq | heqN] := Nat.eq_dec (to_nat x) (to_nat y).
  by left; apply: to_nat_inj.
by right=> H; apply: heqN; rewrite H.
Qed.

但即便如此，使用起来仍然很麻烦。您可以尝试在ssreflect中使用'I_n类型include，它将计算值与边界分开，在SO中进行一些搜索可以为您提供足够的指针。

如果您将Qed转换为Defined，以上内容将根据您的情况进行计算，一般来说，只要left ?或right ?允许就足够了取决于它的证据继续。

然而，如果你希望它在非相等的情况下通过正常形式需要进行一些大量的调整[主要是O_S引理是不透明的，这也会影响Nat.eq_dec] < / p>

答案 1 :(得分：1)

你可以手工编写这些术语，但这是一场噩梦。在这里，我描述了计算部分和使用策略来处理证明：

Fixpoint feq_dec {m : nat} (x y : fin m) : P x y.
refine (
match m return forall (x y : fin m), P x y with
  | O    => _
  | S m' => fun x y =>
  match (case x, case y) with
    | (inright eqx            , inright eqy)             => left _
    | (inleft (exist _ x' eqx), inright eqy)             => right _
    | (inright eqx            , inleft (exist _ y' eqy)) => right _
    | (inleft (exist _ x' eqx), inleft (exist _ y' eqy)) =>
    match feq_dec _ x' y' with
      | left eqx'y'   => left _
      | right neqx'y' => right _
    end
  end
end x y); simpl in *; subst.
- inversion 0.
- reflexivity.
- intro Heq; apply neqx'y'.
  assert (Heq' : Some x' = Some y') by exact (f_equal finpred Heq).
  inversion Heq'; reflexivity.
- inversion 1.
- inversion 1.
- reflexivity.
Defined.

以这种方式定义的函数按预期工作：

Compute (@feq_dec 5 (FS F1) (FS F1)).
(* 
 = left eq_refl
 : P (FS F1) (FS F1)
*)

此代码依赖于3个技巧：

1。首先检查绑定的m。

事实上，如果您对绑定的m一无所知，您将分别从x和y的匹配中了解两个不同的事实，您需要协调这些事实（即表明你给出的m的两个前身实际上是平等的）。另一方面，如果您知道m的形状为S m'，那么您可以......

2。使用case函数根据边界的形状反转术语

如果你知道绑定的形状为S m'，那么你知道你的fin中的每一个都处于以下两种情况之一：fin是{{{ 1}}或某些F1为FS x'。 x'使这个正式：

case

Coq足够聪明，可以检测到我们从Definition C {m : nat} (x : fin (S m)) := { x' | x = FS x' } + { x = F1 }. Definition case {m : nat} (x : fin (S m)) : C x := match x in fin (S n) return { x' | x = FS x' } + { x = F1 } with | F1 => inright eq_refl | FS x' => inleft (exist _ x' eq_refl) end. 返回的值是它所需参数的直接子项。因此，当case和x具有y形状时，执行递归调用不会有问题！

3。使用与偶然函数的同余来剥离构造函数

在我们执行递归调用但得到否定答案的分支中，我们需要证明FS _知道FS x' <> FS y'。这意味着我们需要将x' <> y'转换为Heq : FS x' = FS y'。

由于x' = y'具有复杂的返回类型，因此只需在FS上执行inversion就不会产生可用的结果（我们在nat {{1}的相关对之间得到相等的结果和Heq）。这是p开始发挥作用：它是一个完整的函数，当面对fin p时，只需剥离finpred构造函数。

FS _

结合FS和Definition finpred {m : nat} (x : fin m) : option (fin (pred m)) := match x with | F1 => None | FS x' => Some x' end. ，我们得到f_equal我们可以使用Heq的证据，并获得我们想要的平等。

编辑：我已经放了all the code in a self-contained gist。

相关问题
最新问题