Recursion 如何进行模式匹配以转换证明

我正在处理coq，我正在尝试创建一个函数，该函数可用于查找列表中的某些内容，并返回与之相关联的证明，即指定元素在列表中

Program Fixpoint lookup
  (A : Set)
  (B : Set)
  (dec : (forall x y : A, {x = y} + {x <> y}))
  (l : list (A * B))
  (a : A)
  {struct l}
  : option {b : B | assoc A B l a b}
:= match l with
   | [] => None
   | (pair v t) :: tl => if dec v a
                           then (Some (exist (assoc A B ((pair v t) :: tl) a) t (assocHead A B tl a t)))
                           else match (lookup A B dec tl a) with
                           -- In the case below we have proven it's in the
                           -- tail of the list.
                           -- How to use that to create new proof with assocTail?
                           | Some (exist _ _ _) => None
                           | None => None
                           end
   end.

在我的例子中，我有一个元组列表，我想根据元组的第一个元素进行查找

所以首先我定义了一个

assoc

归纳谓词，它证明元素在列表中。这有两种情况。元素要么在列表的开头，要么在列表的结尾

Inductive assoc (A : Set) (B : Set) : list (A * B) -> A -> B -> Prop :=
  | assocHead : forall (l : list (A * B)) (a : A) (b : B), assoc A B (cons (a,b) l) a b
  | assocTail : forall (l : list (A * B)) (a x : A) (b y : B), assoc A B l a b -> assoc A B ((x,y) :: l) a b.

然后我定义了一个

lookup

函数，该函数给定一个元组列表，第一个元素和一个相等谓词返回None或Some，并证明元素在列表中

Program Fixpoint lookup
  (A : Set)
  (B : Set)
  (dec : (forall x y : A, {x = y} + {x <> y}))
  (l : list (A * B))
  (a : A)
  {struct l}
  : option {b : B | assoc A B l a b}
:= match l with
   | [] => None
   | (pair v t) :: tl => if dec v a
                           then (Some (exist (assoc A B ((pair v t) :: tl) a) t (assocHead A B tl a t)))
                           else match (lookup A B dec tl a) with
                           -- In the case below we have proven it's in the
                           -- tail of the list.
                           -- How to use that to create new proof with assocTail?
                           | Some (exist _ _ _) => None
                           | None => None
                           end
   end.

程序定点查找
（一套）
（乙：一套）
（dec:（对于所有xy:A，{x=y}+{xy}））
（l：名单（A*B））
（a:a）
{struct l}
：选项{b:b | assoc A b l A b}
：=将l与
|[]=>无
|（对VT）：：tl=>如果dec v a
然后（一些（存在（关联A B（（对v t）：：tl）A（关联A B tl A t）））
else匹配（查找A B dec tl A）与
--在下面的例子中，我们已经证明了
--名单的末尾。
--如何使用它来创建新的assocTail证明？
|一些（存在）=>无
|无=>无
终止
终止

上面写的方式编译得很好。但是我不知道如何使用列表的

tl

中的证明来创建一个新的证明，证明它在总列表中。我在

exist

的第三个参数中尝试了各种各样的方法，比如模式匹配，但我始终无法让它起作用

---

感谢您的帮助

通过递归调用对

exist

进行模式匹配后，您知道该对的第一个组件也是结果的第一个组件。第二部分是证明你可以作为一项单独的义务来填补

match lookup ... with
| Some (exist _ b _) => Some (exist _ b _ (* this underscore becomes an obligation *))
| None => None
end

这允许

程序定义

命令完成，然后您必须证明一项义务（引理）来实际完成该定义。请确保使用定义的

而不是
Qed
终止证明，因为担保检查程序不知何故需要您的证明是透明的

Next Obligation.
  (* finish the proof *)
Defined.


程序定点查找
（一套）
（乙：一套）
（dec:（对于所有xy:A，{x=y}+{xy}））
（l：名单（A*B））
（a:a）
{struct l}
：选项{b:b | assoc A b l A b}
：=将l与
|[]=>无
|（对v t）：：tl=>
如果十二月五日
然后（一些（存在（关联A B（（对v t）：：tl）A（关联A B tl A t）））
else匹配（查找A B dec tl A）与
|一些（存在）=>一些（存在）
|无=>无
终止
终止
下一项义务。
应用assocTail。
假定
定义
首先，最好像这样编写
assoc

Inductive assoc {A B : Type} (k : A) (v : B) : list (A * B) -> Prop :=
| assoc_head : forall l, assoc k v ((k, v) :: l)
| assoc_tail : forall l x, assoc k v l -> assoc k v (x :: l).
Arguments assoc_head {A B} {k v}, {A B} k v, A B k v.
Arguments assoc_tail {A B} {k v} {l}, {A B} {k v} l, {A B} k v l, A B k v l.

基本上，在
：
左侧放置的内容越多，处理类型就越容易（参数越多，索引越少）。事实上，我会更进一步写

Inductive elem {A : Type} (x : A) : list A -> Prop :=
| in_here : forall l, elem x (x :: l)
| in_there : forall l y, elem x l -> elem x (y :: l).
Definition assoc {A B : Type} (k : A) (v : B) l := elem (k, v) l.

但这已经偏离了方向

无论如何，您不需要检查代码中是否存在
的第三个参数。您只需将其交给
assoc\u tail
。完成了

#[program] Fixpoint lookup
  {A B : Type} (dec : forall x y : A, {x = y} + {x <> y})
  (l : list (A * B)) (k : A) {struct l}
: option {v : B | assoc k v l}
:=
  match l with
  | [] => None
  | (k', v') as h :: l =>
    if dec k' k (* writing the first argument to exist is usually just clutter *)
      then Some (exist _ v' (assoc_head k' v' l))
      else
        match lookup dec l k with
        | Some (exist _ v prf) => Some (exist _ v (assoc_tail h prf))
        | None => None
        end
  end.

注意，
查找
比只返回一个
选项
要好

#[local] Hint Constructors assoc : core.
#[local] Unset Program Cases.

#[program] Fixpoint lookup
  {A B : Type} (dec : forall x y : A, {x = y} + {x <> y})
  (l : list (A * B)) (k : A) {struct l}
: {v : B | assoc k v l} + {~exists v : B, assoc k v l}
:=
  match l with
  | [] => inright _ (* Underscores as an "escape hatch" to an obligation *)
  | (k', v') :: l =>
    if dec k' k
      then inleft v'
      else
        match lookup dec l k with
        | inleft v => inleft v
        | inright no => inright _
        end
  end.
Next Obligation.
  intros [v no].
  inversion no.
Qed.
Next Obligation.
  intros [v nono].
  inversion nono as [? | ? ? nono']; eauto.
Qed.

#[local]提示构造函数assoc:core。
#[本地]未设置的程序案例。
#[程序]定点查找
{ab:Type}（dec:forall xy:A，{x=y}+{xy}）
（l:list（A*B））（k:A）{struct l}
：{v:B | assoc k v l}+{~exists v:B，assoc k v l}
:=
匹配
|[]=>在右侧（*下划线为义务的“逃生舱口”）
|（k'，v'）：：l=>
如果dec k'k
然后在左v'
其他的
将查找declk与
|inleft v=>inleft v
|右侧否=>右侧_
终止
终止
下一项义务。
介绍[v编号]。
倒装号。
Qed。
下一项义务。
介绍[v nono]。
反转nono为[？|？nono']；奥托。
Qed。
库中已有一个谓词
，用于指定列表是否包含元素，因此您实际上不需要定义新的
assoc
谓词

你可以尝试使用
精炼
策略，我发现这对逐步建立术语很有帮助。这有点像使用
程序
，但感觉不那么神奇。您尽可能多地编写术语（即
析构函数将生成的匹配语句），并将其放入
\uu
中，以获得证明义务。你可以使用证明策略来证明义务，看看你建立了什么样的术语。这很有启发性

我最终完成了这个项目：

Require Import List.

Fixpoint lookup {A B} (dec: forall (a a':A), {a=a'}+{a<>a'})
         (l:list (A*B)) (a:A) {struct l} : option {b | In (a,b) l}.
  refine (
      match l with
      | nil => None
      | cons (a',b) l' =>
        match dec a a' with
        | left _ y => Some (exist _ b (or_introl _))
        | right _ y  =>
          match lookup _ _ dec l' a with
          | None => None
          | Some (exist _ b' H') => Some (exist _ b' (or_intror H'))
          end
        end
      end).
  congruence.
Defined.

需要导入列表。
不动点查找{ab}（dec:forall（aa）：A），{A=A'}+{aa'}）
（l:list（A*B））（A:A）{struct l}：option{B|In（A，B）l}。
精炼(
匹配
|无=>无
|反对意见（a'，b）l'=>
与…匹配
|左u-y=>Some（exist u-b（或u-introl)））
|右uy=>
匹配查找uu_uudec l'a与
|无=>无
|一些（exist b'H'）=>一些（exist b'（或intror H'））
终止
终止
(完)。
相似
定义

请注意，出于教学方面的原因，我在学期中留下了一个
。
，这是通过
一致性
策略解决的

Require Import List.

Fixpoint lookup {A B} (dec: forall (a a':A), {a=a'}+{a<>a'})
         (l:list (A*B)) (a:A) {struct l} : option {b | In (a,b) l}.
  refine (
      match l with
      | nil => None
      | cons (a',b) l' =>
        match dec a a' with
        | left _ y => Some (exist _ b (or_introl _))
        | right _ y  =>
          match lookup _ _ dec l' a with
          | None => None
          | Some (exist _ b' H') => Some (exist _ b' (or_intror H'))
          end
        end
      end).
  congruence.
Defined.