(* Coq'Art CH 13 *)
(* CH 13.1 *)
Set Implicit Arguments.

CoInductive LList (A:Set) : Set := 
   LNil : LList A |
   LCons : A -> LList A -> LList A.

Implicit Arguments LNil [A].


(* CH 13.2 *)
Fixpoint LNth (A:Set) (n:nat) (l:LList A){struct n} : option A :=
 match l with
  LNil => None |
  LCons a l' => match n with
   O => Some a |
   S p => LNth p l' end
  end.


(* CH 13.3 *)
CoFixpoint from (n:nat) : LList nat := LCons n (from (S n)).

CoFixpoint repeat (A:Set)(a:A) : LList A := LCons a (repeat a).

CoFixpoint LAppend (A:Set) (u v: LList A) : LList A :=
 match u with
  LNil => v |
  LCons a u' => LCons a (LAppend u' v)
 end.

CoFixpoint general_omega (A:Set) (u v:LList A) : LList A :=
 match v with
  LNil => u |
  LCons b v' =>
   match u with
    LNil => LCons b (general_omega v' v) |
    LCons a u' => LCons a (general_omega u' v)
   end
 end.

Definition omega (A:Set) (u:LList A) : LList A :=
 general_omega u u.


(* CH 13.4 *)
Definition LList_decompose (A:Set) (l:LList A) : LList A :=
 match l with
  LNil => LNil |
  LCons a l' => LCons a l'
 end.

Theorem LList_decomposition_lemma: forall (A:Set) (l:LList A), l = LList_decompose l.
Proof.
intro a.
intro l.
case l.
simpl.
reflexivity.

intro b.
intro l'.
simpl.
reflexivity.
Qed.

Ltac LList_unfold term := apply trans_equal with (1 := LList_decomposition_lemma term).

Theorem LAppend_LNil : forall (A:Set) (v:LList A), LAppend LNil v = v.
Proof.
intro A.
intro v.
LList_unfold (LAppend LNil v).
case v.
simpl.
reflexivity.

intro a.
intro l.
simpl.
reflexivity.
Qed.

Theorem LAppend_LCons : forall (A:Set) (a:A) (u v:LList A),
 LAppend (LCons a u) v = LCons a (LAppend u v).
Proof.
intros A a u v.
LList_unfold (LAppend (LCons a u) v).
case v.
simpl.
reflexivity.

intros a0 l.
simpl.
reflexivity.
Qed.

Hint Resolve LAppend_LNil LAppend_LCons : llists.
Hint Rewrite LAppend_LNil LAppend_LCons : llists.


(* CH 13.5 *)
Inductive Finite (A:Set) : LList A -> Prop :=
 Finite_LNil : Finite LNil |
 Finite_LCons : forall (a:A) (l:LList A), Finite l -> Finite (LCons a l).

Hint Rewrite Finite_LNil Finite_LCons : llists.
Hint Resolve Finite_LNil Finite_LCons : llists.

Theorem Finite_of_LCons : forall (A:Set) (a:A) (l:LList A), Finite (LCons a l) -> Finite l.
Proof.
intros A a l x.
inversion x.
exact H0.
Qed.

Lemma from_unfold: forall n:nat, from n = LCons n (from (S n)).
Proof.
intro n.
LList_unfold (from n).
simpl.
reflexivity.
Qed.


(* CH 13.6 CO-INDUCTIVE PREDICATES *)
CoInductive Infinite (A:Set) : LList A -> Prop :=
 Infinite_LCons : forall (a:A) (l:LList A), Infinite l -> Infinite (LCons a l).

Hint Rewrite Infinite_LCons : llists.
Hint Resolve Infinite_LCons : llists.

Definition F_from : (forall n:nat, Infinite (from n)) -> forall n:nat, Infinite (from n).
intro H.
intro n.
rewrite (from_unfold n).
split.
apply H.
Defined.

Theorem from_Infinite_V0 : forall n:nat, Infinite (from n).
Proof cofix H : forall n:nat, Infinite (from n) := F_from H.

Theorem from_Infinite_V1 : forall n:nat, Infinite (from n).
Proof.
cofix H.
apply (F_from H).
Qed.

Theorem from_Infinite : forall n:nat, Infinite (from n).
Proof.
cofix H.
(* apply H. *)
(* Guarded. *)
intro n.
rewrite (from_unfold n).
apply Infinite_LCons.
apply H.
Qed.

Theorem LNil_not_Infinite : forall A:Set, ~Infinite (LNil (A:=A)).
Proof.
intro A.
unfold not.
intro H.
inversion H.
Qed.


(* ex 13.12 *)
Lemma repeat_unfold: forall A:Set, forall a:A, repeat a = LCons a (repeat a).
Proof.
intro A.
intro a.
LList_unfold (repeat a).
simpl.
reflexivity.
Qed.

Lemma repeat_infinite : forall (A:Set) (a:A), Infinite (repeat a).
Proof.
intro A.
cofix a.
intro b.
rewrite (repeat_unfold b).
apply Infinite_LCons.
apply a.
Qed.


(* ex 13.15 *)
Theorem Infinite_of_LCons : forall (A:Set ) (a:A) (u:LList A), Infinite (LCons a u) -> Infinite u.
Proof.
intros A a u x.
inversion x.
exact H0.
Qed.

Lemma LAppend_of_Infinite : forall (A:Set) (u:LList A), Infinite u -> forall (v:LList A), Infinite (LAppend u v).
Proof.
intros A.
cofix H.
intros u.
case u.
intro H0.
inversion H0.

intros a l H0 v.
autorewrite with llists using auto with llists.
split.
apply H.
inversion H0.
exact H2.
Qed.

Lemma Finite_not_Infinite : forall (A:Set) (l:LList A), Finite l -> ~Infinite l.
Proof.
intros A l H.
elim H.
unfold not.
intro H0.
inversion H0.

unfold not.
intros a l0 H0 H1 H2.
inversion H2.
apply H1.
exact H4.
Qed.

Lemma Infinite_not_Finite : forall (A:Set) (l:LList A), Infinite l -> ~Finite l.
Proof.
unfold not.
intros A l H H0.
absurd (Infinite l).
apply Finite_not_Infinite.
exact H0.

exact H.
Qed.

Lemma Not_Finite_Infinite : forall (A:Set) (l:LList A), ~Finite l -> Infinite l.
unfold not.
cofix H.
intros A l.
case l.
intro H0.
absurd (Finite (LNil (A := A))).
exact H0.

apply Finite_LNil.

intros a l0 H0.
apply Infinite_LCons.
apply H.
intro H1.
apply H0.
apply Finite_LCons.
exact H1.
Qed.


(* H13.7  BISIMILARITY*)
CoInductive bisimilar (A:Set) : LList A -> LList A -> Prop :=
bisim_LNil : bisimilar LNil LNil |
bisim_LCons : forall (a:A) (l l':LList A), bisimilar l l' -> bisimilar (LCons a l) (LCons a l').

Hint Rewrite bisim_LNil bisim_LCons : llists.
Hint Resolve bisim_LNil bisim_LCons : llists.


(* ex 13.9 *)
Require Import Relations.

Check reflexive.

Lemma bisimilar_refl : forall (A:Set), reflexive (LList A) (bisimilar (A:=A)).
Proof.
intro A.
unfold reflexive.
cofix H.
intro u.
case u.
apply bisim_LNil.

intros a l.
apply bisim_LCons.
apply H.
Qed.


Hint Resolve bisimilar_refl: llists.

Lemma bisimilar_sym : forall (A:Set), symmetric (LList A) (bisimilar (A:=A)).
unfold symmetric.
intro A.
cofix H.
destruct x; destruct y.
auto with llists.

intro H0.
inversion H0.

intro H0.
inversion H0.

intro H0.
inversion H0.
apply bisim_LCons.
auto.
Qed.

Lemma bisimilar_trans : forall (A:Set), transitive (LList A) (bisimilar (A:=A)).
Proof.
unfold transitive.
intro A.
cofix H.
intros x.
case x.
intros y.
case y.
auto.

intros a l w H0.
inversion H0.

destruct y.
intros z H0.
inversion H0.

intros z.
intro H0.
intro H1.
inversion_clear H1.
inversion_clear H0.
apply bisim_LCons.
eapply H.
eauto.
exact H2.
Qed.

Theorem bisimilar_equiv : forall (A:Set), equiv (LList A) (bisimilar (A:=A)).
Proof.
split.
apply bisimilar_refl.
split.
apply bisimilar_trans.
apply bisimilar_sym.
Qed.


(* ex13.21 *)
Theorem bisimilar_of_Finite_is_Finite : forall (A:Set) (l:LList A), Finite l -> forall (l':LList A), bisimilar l l' -> Finite l'.
Proof.
intros A l H.
elim H.
intro l'.
case l'.
intro H0.
apply Finite_LNil.

intros a l0 H0.
inversion H0.

intros a l0 H0 H1 l'.
case l'.
intro H2.
inversion H2.

intros a0 l1 H2.
inversion H2.
apply Finite_LCons.
apply H1.
exact H4.
Qed.

Theorem bisimilar_of_Infinite_is_Infinite : forall (A:Set) (l:LList A), Infinite l -> forall (l':LList A), bisimilar l l' -> Infinite l'.
Proof.
intros A.
cofix H.
intro l.
case l.
intro H0.
inversion H0.

intros a l0 H0 l'.
case l'.
intro H1.
inversion H1.

intros a0 l1 H1.
apply Infinite_LCons.
apply H with l0.
apply Infinite_of_LCons with a.
exact H0.

inversion H1.
exact H3.
Qed.


(* ex 13.22 *)
Theorem bisimilar_of_Finite_is_eq : forall (A:Set) (l:LList A), Finite l -> forall (l':LList A), bisimilar l l' -> l = l'.
Proof.
intros A l H.
elim H.
intros l' H0.
inversion H0.
reflexivity.

intros a l0 H0 H1 l'.
case l'.
intro H2.
inversion H2.

intros a0 l1 H2.
inversion H2.
rewrite (H1 l1).
reflexivity.

exact H4.
Qed.


Theorem LAppend_assoc : forall (A:Set)(u v w:LList A), bisimilar (LAppend u (LAppend v w)) (LAppend (LAppend u v) w).
Proof.
intro A.
cofix H.
intros u.
case u.
intros v w.

autorewrite with llists.
apply bisimilar_refl.

intros a l v w.
autorewrite with llists.
auto with llists.
Qed.