Search code examples
coqcoinduction

Defining equality relation for infinite trees


In coq i can define equality relations for coinductive types whose components are pairs:

Section Pairs.
Variable (A:Type).
CoInductive Stream :=
  cons : (A * Stream) -> Stream.

CoInductive Stream_eq : Stream -> Stream -> Prop := 
  stream_eq : forall t1 t2 b1 b2, Stream_eq (t1) (t2)
               -> (b1 = b2)
               -> Stream_eq (cons (b1,t1)) (cons (b2,t2)).
End Pairs.

I can also do this for types whose components are functions:

Section Functions.
Variable (A:Type).
CoInductive Useless :=
   cons_useless : (A -> Useless) -> Useless.

CoInductive Useless_eq : Useless -> Useless -> Prop := 
  useless_eq : forall t1 t2, (forall b, Useless_eq (t1 b) (t2 b))
                   -> Useless_eq (cons_useless t1) (cons_useless t2).
End Functions.

But i can't seem to define analogous relation for types whose components are functions to pairs:

Section FunctionsToPairs.
Variable (A:Type).
Variable (B:Type).
CoInductive InfiniteTree :=
  cons_tree : (A -> B * InfiniteTree) -> InfiniteTree.
CoInductive Tree_eq : InfiniteTree -> InfiniteTree -> Prop := 
  tree_eq : forall (t1:A -> B*InfiniteTree) (t2:A -> B*InfiniteTree), 
     (forall b, let (a1, c1) := (t1 b) in
                let (a2, c2) := (t2 b) in Tree_eq c1 c2 /\ a1 = a2)
                   -> Tree_eq (cons_tree t1) (cons_tree t2).
End FunctionsToPairs.

I get error:

Non strictly positive occurrence of "Tree_eq" in
 "forall t1 t2 : A -> B * InfiniteTree,
  (forall b : A, let (a1, c1) := t1 b in let (a2, c2) := t2 b in Tree_eq c1 c2 /\ a1 = a2) ->
  Tree_eq (cons_tree t1) (cons_tree t2)".

Is there any way to have a well-defined equality relation for the InfiniteTree type?


Solution

  • Your definition is mostly rejected due to the use of let-in constructs that prevents the checker from establishing that the occurrence of Tree_eq c1 c2 in the constructor tree_eq is valid. If you remove them, or write them differently, the definition is accepted by Coq.

    For example, the following works:

    CoInductive Tree_eq : InfiniteTree -> InfiniteTree -> Prop := 
      tree_eq : forall (t1:A -> B*InfiniteTree) (t2:A -> B*InfiniteTree), 
         (forall b, let x1 := (t1 b) in
                    let x2 := (t2 b) in Tree_eq (snd x1) (snd x2) /\ fst x1 = fst x2)
                       -> Tree_eq (cons_tree t1) (cons_tree t2).
    

    Note that with primitive projections enabled, your original definition works (the idea comes from this answer by @JasonGross).

    Set Primitive Projections.
    
    Record prod {A B} := pair { fst : A ; snd : B }.
    Arguments prod : clear implicits.
    Arguments pair {A B}.
    Add Printing Let prod.
    Notation "x * y" := (prod x y) : type_scope.
    Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope.
    Hint Resolve pair : core.
    
    Section FunctionsToPairs.
    Variable (A:Type).
    Variable (B:Type).
    CoInductive InfiniteTree :=
      cons_tree : (A -> B * InfiniteTree) -> InfiniteTree.
    CoInductive Tree_eq : InfiniteTree -> InfiniteTree -> Prop := 
      tree_eq : forall (t1:A -> B*InfiniteTree) (t2:A -> B*InfiniteTree), 
         (forall b, let (a1, c1) := (t1 b) in
                    let (a2, c2) := (t2 b) in Tree_eq c1 c2 /\ a1 = a2)
                       -> Tree_eq (cons_tree t1) (cons_tree t2).
    End FunctionsToPairs.