Coq 依赖模式匹配要求使用通配符而不是正确的类型

注意：此代码与中的代码类似（但不完全相同）。当代码处理相等的问题时，它尝试在这个小语言中扩展加法以包括对

Inductive type : Set :=
| Nat
| Bool
| Pair : type -> type -> type.

Inductive numeric: type -> Set :=
| NNat: numeric Nat
| MPair: forall a1 a2, numeric a1 -> numeric a2 -> numeric (Pair a1 a2).

Inductive tbinop : type -> type -> type -> Set :=
| TPlus : forall t, numeric t -> tbinop t t t
| TTimes : forall t, numeric t -> tbinop t t t
| TEq : forall t, tbinop t t Bool
| TLt : tbinop Nat Nat Bool
| TPair : forall in1 in2, tbinop in1 in2 (Pair in1 in2).

Inductive texp : type -> Set :=
| TNConst : nat -> texp Nat
| TBConst : bool -> texp Bool
| TBinop : forall t1 t2 t, tbinop t1 t2 t -> texp t1 -> texp t2 -> texp t.

Fixpoint typeDenote (t : type) : Set :=
  match t with
    | Nat => nat
    | Bool => bool
    | Pair l r => prod (typeDenote l) (typeDenote r)
  end.

Fixpoint typeDepth (t: type): nat :=
  match t with
  | Nat => 1
  | Bool => 1
  | Pair A B => 1 + Nat.max (typeDepth A) (typeDepth B)
  end.

Program Fixpoint tbinopDepth arg1 arg2 res (b: tbinop arg1 arg2 res)
{measure (Nat.max (typeDepth arg1) (typeDepth arg2))}
  : nat :=
match b with
| TPlus _ => 1
| TTimes _ => 1
| TEq Nat => 1
| TEq Bool => 1
| TEq (Pair A B) => tbinopDepth (TPair A B)
| TLt => 1
| TPair A B => 1 + Nat.max (typeDepth A) (typeDepth B)
end.
Next Obligation.
simpl.
rewrite Nat.max_idempotent.
omega.
Qed.

Eval compute in tbinopDepth (TEq (Pair Nat Nat)). (* 2 *)
Eval compute in tbinopDepth (TEq Nat). (* 1 *)

Program Fixpoint tbinopDenote arg1 arg2 res (b : tbinop arg1 arg2 res)
  {measure (tbinopDepth b)} : typeDenote arg1 -> typeDenote arg2 -> typeDenote res :=
  match b with
    | TPlus MNat => fun (a:typeDenote Nat) (b:typeDenote Nat) => plus a b : typeDenote Nat
    | TPlus (MPair A B) => fun (a:typeDenote (Pair A B)) (b:typeDenote (Pair A B)) =>
        match a, b with
        | (x1, x2), (y1, y2) => (x1 + y1, x2 + y2)
        end : typeDenote (Pair A B)
    | TEq Nat => beq_nat
    | TEq Bool => eqb
    | TEq (Pair A B) => fun (a:typeDenote (Pair A B)) (b:typeDenote (Pair A B)) =>
        false (* obviously extremely wrong, doing this to unlock pending https://stackoverflow.com/questions/62912587/some-help-proving-coq-function-terminates *)
        (*match a, b with
        | (x1, x2), (y1, y2) => eqb (tbinopDenote (TEq A) x1 y1) (tbinopDenote (TEq B) x2 y2)
        end : typeDenote Bool*)
    | TLt => leb
    | TPair _ _ => fun a b => (a,b)
  end.

当我试图编译它时，我得到了错误

Found type "typeDenote Nat" where "typeDenote wildcard'" was expected.

我的猜测是，我需要某种方式来连接

typeindicate Nat

到

TPlus MNat

。我不知道。我将继续搜索有关Coq依赖模式匹配的信息。如果有任何关于如何实现这类事情的建议，我将不胜感激，因为约束在其他归纳类型上的归纳类型在证明中似乎非常常见

编辑：我应该补充一点，我的天真想法是比赛应该是这样的：

| TPlus Nat => fun (a:typeDenote Nat) (b:typeDenote Nat) => plus a b : typeDenote Nat

但是它说：

找到了归纳类型的构造函数，而预期的构造函数是numeric。

。所以我猜它会自动缩小范围并进行替换，但我不知道如何将它连接回Nat以进行类型检查

Edit2：所以，阅读文档，玩转游戏，我得出了以下结论：

Program Fixpoint tbinopDenote arg1 arg2 res (b : tbinop arg1 arg2 res)
  {measure (tbinopDepth b)} : typeDenote arg1 -> typeDenote arg2 -> typeDenote res :=
  match b in tbinop arg1 arg2 res return (typeDenote arg1 -> typeDenote arg2 -> typeDenote res) with
    | @TPlus Nat MNat => fun (a:typeDenote Nat) (b:typeDenote Nat) => plus a b : typeDenote Nat
    | @TPlus (Pair A B) (MPair A' B') => fun (a:typeDenote (Pair A B)) (b:typeDenote (Pair A B)) =>
        match a, b with
        | (x1, x2), (y1, y2) => (tbinopDenote (@TPlus A A') x1 y1, tbinopDenote (@TPlus B B') x2 y2)
        end : typeDenote (Pair A B)
    | @TPlus _ _ => !
    | TEq Nat => beq_nat
    | TEq Bool => eqb
    | TEq (Pair A B) => fun (a:typeDenote (Pair A B)) (b:typeDenote (Pair A B)) =>
        false (* obviously extremely wrong, doing this to unlock pending https://stackoverflow.com/questions/62912587/some-help-proving-coq-function-terminates *)
        (*match a, b with
        | (x1, x2), (y1, y2) => eqb (tbinopDenote (TEq A) x1 y1) (tbinopDenote (TEq B) x2 y2)
        end : typeDenote Bool*)
    | TLt => leb
    | TPair _ _ => fun a b => (a,b)
  end.

编译时，出现以下错误：

The term "x1" has type
 "(fix typeDenote (t : type) : Set :=
     match t with
     | Nat => nat
     | Bool => bool
     | Pair l r => (typeDenote l * typeDenote r)%type
     end) A" while it is expected to have type
 "tbinopDepth
    (TPlus (eq_rect t0 (fun H : type => numeric H) A' A ?e@{b0:=b; b:=b0})) <
  tbinopDepth b".

---

如果这确实是正确的方法，有没有办法证明a=a'和B=B'？有必要吗？

这与您提到的问题相同：只需分别定义数值运算：

Require Import Coq.Arith.Arith.
Set Implicit Arguments.

Inductive type : Type :=
| Nat
| Bool
| Pair : type -> type -> type.

Inductive numeric: type -> Set :=
| NNat: numeric Nat
| MPair: forall a1 a2, numeric a1 -> numeric a2 -> numeric (Pair a1 a2).

Inductive tbinop : type -> type -> type -> Set :=
| TPlus : forall t, numeric t -> tbinop t t t
| TTimes : tbinop Nat Nat Nat
| TEq : forall t, tbinop t t Bool
| TLt : tbinop Nat Nat Bool
| TPair : forall in1 in2, tbinop in1 in2 (Pair in1 in2).

Inductive texp : type -> Set :=
| TNConst : nat -> texp Nat
| TBConst : bool -> texp Bool
| TBinop : forall t1 t2 t, tbinop t1 t2 t -> texp t1 -> texp t2 -> texp t.

Fixpoint typeDenote (t : type) : Type :=
  match t with
    | Nat => nat
    | Bool => bool
    | Pair l r => prod (typeDenote l) (typeDenote r)
  end.

Fixpoint typeDepth (t: type): nat :=
  match t with
  | Nat => 1
  | Bool => 1
  | Pair A B => 1 + Nat.max (typeDepth A) (typeDepth B)
  end.

Fixpoint add t (n : numeric t) : typeDenote t -> typeDenote t -> typeDenote t :=
  match n in (numeric t0) return (typeDenote t0 -> typeDenote t0 -> typeDenote t0) with
  | NNat => Nat.add
  | @MPair a1 a2 n0 n1 => fun '(x1, y1) '(x2, y2) => (add n0 x1 x2, add n1 y1 y2)
  end.

Fixpoint eqb arg : typeDenote arg -> typeDenote arg -> bool :=
  match arg return typeDenote arg -> typeDenote arg -> bool with
  | Nat => Nat.eqb
  | Bool => Bool.eqb
  | Pair A B => fun '(x1, y1) '(x2, y2) => andb (eqb _ x1 x2) (eqb _ y1 y2)
  end.

Fixpoint tbinopDenote arg1 arg2 res (b : tbinop arg1 arg2 res) {struct arg1}
    : typeDenote arg1 -> typeDenote arg2 -> typeDenote res :=
  match b in tbinop arg1 arg2 res return typeDenote arg1 -> typeDenote arg2 -> typeDenote res with
  | TPlus n => add n
  | TTimes => Nat.mul
  | TEq arg => eqb arg
  | TLt => leb
  | TPair _ _ => fun a b => (a,b)
  end.

---

的确非常感谢你的两个答案。我需要弄清楚如何更好地理解Coq中的依赖模式匹配，但这是一个很好的开始。再次感谢您（如果您对依赖模式匹配有任何深入的建议，我洗耳恭听！）

Require Import Coq.Arith.Arith.
Set Implicit Arguments.

Inductive type : Type :=
| Nat
| Bool
| Pair : type -> type -> type.

Inductive numeric: type -> Set :=
| NNat: numeric Nat
| MPair: forall a1 a2, numeric a1 -> numeric a2 -> numeric (Pair a1 a2).

Inductive tbinop : type -> type -> type -> Set :=
| TPlus : forall t, numeric t -> tbinop t t t
| TTimes : tbinop Nat Nat Nat
| TEq : forall t, tbinop t t Bool
| TLt : tbinop Nat Nat Bool
| TPair : forall in1 in2, tbinop in1 in2 (Pair in1 in2).

Inductive texp : type -> Set :=
| TNConst : nat -> texp Nat
| TBConst : bool -> texp Bool
| TBinop : forall t1 t2 t, tbinop t1 t2 t -> texp t1 -> texp t2 -> texp t.

Fixpoint typeDenote (t : type) : Type :=
  match t with
    | Nat => nat
    | Bool => bool
    | Pair l r => prod (typeDenote l) (typeDenote r)
  end.

Fixpoint typeDepth (t: type): nat :=
  match t with
  | Nat => 1
  | Bool => 1
  | Pair A B => 1 + Nat.max (typeDepth A) (typeDepth B)
  end.

Fixpoint add t (n : numeric t) : typeDenote t -> typeDenote t -> typeDenote t :=
  match n in (numeric t0) return (typeDenote t0 -> typeDenote t0 -> typeDenote t0) with
  | NNat => Nat.add
  | @MPair a1 a2 n0 n1 => fun '(x1, y1) '(x2, y2) => (add n0 x1 x2, add n1 y1 y2)
  end.

Fixpoint eqb arg : typeDenote arg -> typeDenote arg -> bool :=
  match arg return typeDenote arg -> typeDenote arg -> bool with
  | Nat => Nat.eqb
  | Bool => Bool.eqb
  | Pair A B => fun '(x1, y1) '(x2, y2) => andb (eqb _ x1 x2) (eqb _ y1 y2)
  end.

Fixpoint tbinopDenote arg1 arg2 res (b : tbinop arg1 arg2 res) {struct arg1}
    : typeDenote arg1 -> typeDenote arg2 -> typeDenote res :=
  match b in tbinop arg1 arg2 res return typeDenote arg1 -> typeDenote arg2 -> typeDenote res with
  | TPlus n => add n
  | TTimes => Nat.mul
  | TEq arg => eqb arg
  | TLt => leb
  | TPair _ _ => fun a b => (a,b)
  end.