Coq equality implementation

Question

I'm writing a toy language where nodes in the AST can have any number of children (Num has 0, Arrow has 2, etc). You might call these operators. Additionally, exactly one node in the AST might be "focused". We index the data type with Z if it has a focus, or H if it doesn't.

I need advice on a few parts of the code. Hopefully it's alright to ask all of these at once, since they're related.

1. How would you define the type of internal nodes with one focus, InternalZ? Right now I say "we have S n children -- n of them are unfocused and one (at some given index) is focused. A slightly more intuitive option (which looks zipper-like) would be InternalZ : forall n m, arityCode (n + 1 + m) -> Vector.t (t H) n -> t Z -> Vector.t (t H) m -> t Z. I know I don't want to deal with that addition, though.

2. Refining types: In both interesting cases in eq I compare the two ns (number of children). If they're the same, I should be able to "coerce" the arityCodes and Vector.ts to have the same type. Right now I hacked this with two lemmas. How should I do this properly? It seems like Adam Chlipala's "convoy pattern" might help but I couldn't work out how.

3. If I uncomment either of the Vector.eqb calls, Coq complains "Cannot guess decreasing argument of fix.". I understand the error but I'm not sure how to circumvent it. The first thing that comes to mind is that I might have to index t by its depth of children.

My code:

Module Typ.
  Import Coq.Arith.EqNat.
  Import Coq.Structures.Equalities.
  Import Coq.Arith.Peano_dec.
  Import Fin.
  Import Vector.

  (* h: unfocused, z: focused *)
  Inductive hz : Set := H | Z.

  (* how many children can these node types have *)
  Inductive arityCode : nat -> Type :=
    | Num   : arityCode 0
    | Hole  : arityCode 0
    (* | Cursor : arityCode 1 *)
    | Arrow : arityCode 2
    | Sum   : arityCode 2
    .

  Definition codeEq (n : nat) (l r : arityCode n) : bool :=
    match l, r with
      | Num, Num     => true
      | Hole, Hole   => true
      | Arrow, Arrow => true
      | Sum, Sum     => true
      | _, _         => false
    end.

  (* our AST *)
  Inductive t : hz -> Type :=
    | Leaf      : arityCode 0 -> t H
    | Cursor    : t H -> t Z
    | InternalH : forall n, arityCode n -> Vector.t (t H) n -> t H
    | InternalZ : forall n, arityCode (S n) -> Vector.t (t H) n -> Fin.t n * t Z -> t Z
    (* alternative formulation: *)
    (* | InternalZ : forall n m, arityCode (n + 1 + m) -> Vector.t (t H) n -> t Z -> Vector.t (t H) m -> t Z *)

    . 

  Lemma coerceArity (n1 n2 : nat) (pf : n1 = n2) (c1 : arityCode n1) : arityCode n2.
    exact (eq_rect n1 arityCode c1 n2 pf).
  Qed.

  Lemma coerceVec {A : Type} {n1 n2 : nat} (pf : n1 = n2) (c1 : Vector.t A n1) : Vector.t A n2.
    exact (eq_rect n1 (Vector.t A) c1 n2 pf).
  Qed.


  (* this is the tricky bit *)
  Fixpoint eq {h_or_z : hz} (ty1 ty2 : t h_or_z) : bool :=
    match ty1, ty2 with
    | Leaf c1, Leaf c2 => codeEq c1 c2
    | Cursor ty1, Cursor ty2 => eq ty1 ty2
    | InternalH n1 c1 ty1, InternalH n2 c2 ty2 =>
      match eq_nat_dec n1 n2 with
        | right _neqPrf => false
        | left eqPrf    => 
          let c1'  := coerceArity eqPrf c1 in
          let ty1' := coerceVec eqPrf ty1 in
          codeEq c1' c2 (* && Vector.eqb _ eq ty1' ty2 *)
        end
     | InternalZ n1 c1 v1 (l1, f1), InternalZ n2 c2 v2 (l2, f2) => 
       match eq_nat_dec n1 n2 with
       | right _neqPrf => false
       | left eqPrf    =>
         let eqPrf' := f_equal S eqPrf in
         let c1'    := coerceArity eqPrf' c1 in
         let v1'    := coerceVec eqPrf v1 in
         codeEq c1' c2 (* && Vector.eqb _ eq v1' v2 *) && Fin.eqb l1 l2 && eq f1 f2 
       end
    | _, _ => false
    end.
End Typ.

Answer 1

Let's start with your third question. Vector.eqb performs nested recursive calls on its first argument. To convince Coq that these are decreasing, we need to make the definition of coerceVec transparent, by replacing Qed with Defined:

Require Coq.Arith.EqNat.
Require Coq.Structures.Equalities.
Require Coq.Arith.Peano_dec.
Require Fin.
Require Vector.

Set Implicit Arguments.

Module Typ.
  Import Coq.Arith.EqNat.
  Import Coq.Structures.Equalities.
  Import Coq.Arith.Peano_dec.
  Import Fin.
  Import Vector.

  (* h: unfocused, z: focused *)
  Inductive hz : Set := H | Z.

  Inductive arityCode : nat -> Type :=
    | Num   : arityCode 0
    | Hole  : arityCode 0
    | Arrow : arityCode 2
    | Sum   : arityCode 2
    .

  Definition codeEq (n : nat) (l r : arityCode n) : bool :=
    match l, r with
      | Num, Num     => true
      | Hole, Hole   => true
      | Arrow, Arrow => true
      | Sum, Sum     => true
      | _, _         => false
    end.

  Inductive t : hz -> Type :=
    | Leaf      : arityCode 0 -> t H
    | Cursor    : t H -> t Z
    | InternalH : forall n, arityCode n -> Vector.t (t H) n -> t H
    | InternalZ : forall n, arityCode (S n) -> Vector.t (t H) n -> Fin.t n * t Z -> t Z
    .

  Lemma coerceArity (n1 n2 : nat) (pf : n1 = n2) (c1 : arityCode n1) : arityCode n2.
    exact (eq_rect n1 arityCode c1 n2 pf).
  Defined.

  Lemma coerceVec {A : Type} {n1 n2 : nat} (pf : n1 = n2) (c1 : Vector.t A n1) : Vector.t A n2.
    exact (eq_rect n1 (Vector.t A) c1 n2 pf).
  Defined.

  Fixpoint eq {h_or_z : hz} (ty1 ty2 : t h_or_z) : bool :=
    match ty1, ty2 with
    | Leaf c1, Leaf c2 => codeEq c1 c2
    | Cursor ty1, Cursor ty2 => eq ty1 ty2
    | @InternalH n1 c1 ty1, @InternalH n2 c2 ty2 =>
      match eq_nat_dec n1 n2 with
        | right _neqPrf => false
        | left eqPrf    =>
          let c1'  := coerceArity eqPrf c1 in
          let ty1' := coerceVec eqPrf ty1 in
          codeEq c1' c2 && Vector.eqb _ eq ty1' ty2
        end
     | @InternalZ n1 c1 v1 (l1, f1), @InternalZ n2 c2 v2 (l2, f2) =>
       match eq_nat_dec n1 n2 with
       | right _neqPrf => false
       | left eqPrf    =>
         let eqPrf' := f_equal S eqPrf in
         let c1'    := coerceArity eqPrf' c1 in
         let v1'    := coerceVec eqPrf v1 in
         codeEq c1' c2 && Vector.eqb _ eq v1' v2 && Fin.eqb l1 l2 && eq f1 f2
       end
    | _, _ => false
    end.
End Typ.

As for your second question: in general, you do need to implement cast operations with equality proofs, like you did with coerceVec. In this particular case, however, it is easier to avoid the cast and write comparison functions that take elements with different indices:

Require Coq.Arith.EqNat.
Require Coq.Structures.Equalities.
Require Coq.Arith.Peano_dec.
Require Fin.
Require Vector.

Set Implicit Arguments.

Module Typ.
  Import Coq.Arith.EqNat.
  Import Coq.Structures.Equalities.
  Import Coq.Arith.Peano_dec.
  Import Fin.
  Import Vector.

  (* h: unfocused, z: focused *)
  Inductive hz : Set := H | Z.

  Inductive arityCode : nat -> Type :=
    | Num   : arityCode 0
    | Hole  : arityCode 0
    | Arrow : arityCode 2
    | Sum   : arityCode 2
    .

  Definition codeEq (n1 n2 : nat) (l : arityCode n1) (r : arityCode n2) : bool :=
    match l, r with
      | Num, Num     => true
      | Hole, Hole   => true
      | Arrow, Arrow => true
      | Sum, Sum     => true
      | _, _         => false
    end.

  Inductive t : hz -> Type :=
    | Leaf      : arityCode 0 -> t H
    | Cursor    : t H -> t Z
    | InternalH : forall n, arityCode n -> Vector.t (t H) n -> t H
    | InternalZ : forall n, arityCode (S n) -> Vector.t (t H) n -> Fin.t n * t Z -> t Z
    .

  Fixpoint eq {h_or_z : hz} (ty1 ty2 : t h_or_z) : bool :=
    match ty1, ty2 with
    | Leaf c1, Leaf c2 => codeEq c1 c2
    | Cursor ty1, Cursor ty2 => eq ty1 ty2
    | @InternalH n1 c1 ty1, @InternalH n2 c2 ty2 =>
      match eq_nat_dec n1 n2 with
        | right _neqPrf => false
        | left eqPrf    =>
          codeEq c1 c2 && Vector.eqb _ eq ty1 ty2
        end
     | @InternalZ n1 c1 v1 (l1, f1), @InternalZ n2 c2 v2 (l2, f2) =>
       match eq_nat_dec n1 n2 with
       | right _neqPrf => false
       | left eqPrf    =>
         codeEq c1 c2 && Vector.eqb _ eq v1 v2 && Fin.eqb l1 l2 && eq f1 f2
       end
    | _, _ => false
    end.
End Typ.

The hardest and most open-ended of your questions is the first one. I think the easiest way to model your type would be by splitting it in two: a type of raw syntax trees, and a type of paths indexed by trees. For example:

Require Fin.
Require Vector.

Set Implicit Arguments.

Module Typ.
  Inductive arityCode : nat -> Type :=
    | Num   : arityCode 0
    | Hole  : arityCode 0
    | Arrow : arityCode 2
    | Sum   : arityCode 2
    .

  Inductive t : Type :=
    | Node : forall n, arityCode n -> Vector.t t n -> t.

  Inductive path : t -> Type :=
    | Here  : forall n (c : arityCode n) (v : Vector.t t n), path (Node c v)
    | There : forall n (c : arityCode n) (v : Vector.t t n) (i : Fin.t n),
                path (Vector.nth v i) -> path (Node c v).
End Typ.

Here, path tree represents the type of indices into a tree tree.

There is often disagreement in the Coq community about how and when to use dependent types. In this particular case, I think it would be easier to have a type t of raw syntax trees and a non-dependent type path of paths into a tree. You can define predicates that express the well-formedness of a path with respect to a tree, and prove after the fact that the functions you care about respect that notion of well-formedness. I find this more flexible in this case because you don't have to worry about manipulating type indices in your functions and reasoning about them (to understand what this means, try to state a the correctness theorem for the original Typ.eq function).