Some help proving coq function terminates

问题

I know this is a common issue :) I will keep reading up, but I've done some searching and thing I don't fully understand how "measure" works

I'm working through Benjamin Pierce's class exercises for Certified Programming with Dependent Types. Here's my code.

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

Inductive tbinop : type -> type -> type -> Set :=
| TPlus : tbinop Nat Nat Nat
| 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.

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 => plus*)
    | TPlus => fun (a:typeDenote Nat) (b:typeDenote Nat) => plus a b : typeDenote Nat
    | TTimes => mult
    | TEq Nat => beq_nat
    | TEq Bool => eqb
    | TEq (Pair A B) => fun (a:typeDenote (Pair A B)) (b:typeDenote (Pair A B)) =>
        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.

However, when I try to compile this I get a type error. Note: if there are ways to restructure this to avoid having to prove this, of course that is ideal! And I welcome any suggestions in that vein. That said, I'd like to understand where I'm going wrong with my measure.

I get an error like this:

The term "x1" has type
 "(fix typeDenote (t : type) : Type :=
     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 (TEq A) < tbinopDepth b".

Which is why I think it's clear I'm not quite understanding how the measure interacts with the code, as I thought the measure would generate a proof obligation, not change the type of the function I'm defining.

I should add that the reason I included the two Evals is because if I can get to a proof goal, "tbinopDepth (TEq A) < tbinopDepth b" is true, since we know b is TEq (Pair A B) so it's probable that tbinopDepth (TEq A) and tbinopDepth (TEq B) are smaller than that. But it won't typecheck...

回答1:

You can solve this issue by defining the equality operator separately:

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

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

Inductive tbinop : type -> type -> type -> Set :=
| TPlus : tbinop Nat Nat Nat
| 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 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 => Nat.add
  | TTimes => Nat.mul
  | TEq arg => eqb arg
  | TLt => leb
  | TPair _ _ => fun a b => (a,b)
  end.

来源：https://stackoverflow.com/questions/62912587/some-help-proving-coq-function-terminates