Require Import List Streams Arith Recdef. Infix "::" := Cons. Infix "==" := EqSt (at level 70, no associativity). Definition st_dec (A:Type)(s:Stream A) := match s with a::s' => a::s' end. Implicit Arguments st_dec. Lemma st_dec_eq : forall A (s:Stream A), s = st_dec s. intros A [a s']; trivial. Qed. Implicit Arguments st_dec_eq [A]. CoFixpoint stroff (A : Type)(f:nat->A) : Stream A := f 0 :: stroff _ (fun x => f (S x)) . Implicit Arguments stroff. Lemma nth_stroff : forall A n (f:nat->A), Str_nth n (stroff f) = f n. induction n; intros f; simpl; auto. exact (IHn (fun x => f (S x))). Qed. Lemma stroff_nth : forall A (s:Stream A), stroff (fun n => Str_nth n s) == s. intros; apply ntheq_eqst; intros; rewrite nth_stroff; auto. Qed. Lemma Str_nth_S : forall A (s:Stream A) n, Str_nth (S n) s = match s with _::s => Str_nth n s end. intros A [a s] n; auto. Qed. Lemma tl_nth_stroff : forall A n (f:nat->A), Str_nth n (tl (stroff f)) = f (S n). simpl; intros A n f; rewrite nth_stroff; auto. Qed. Hint Rewrite Str_nth_S nth_stroff tl_nth_stroff Str_nth_map Str_nth_zipWith : str_mod. Ltac str_eqn_tac := intros; match goal with | |- ?f == _ => unfold f | |- ?f _ == _ => unfold f | |- ?f _ _ == _ => unfold f | |- ?f _ _ _ == _ => unfold f end; apply ntheq_eqst; intros n; rewrite nth_stroff; match goal with | |- ?f' n = _ => functional induction f' n; autorewrite with str_mod; auto | |- ?f' ?a n = _ => functional induction f' a n; autorewrite with str_mod; auto | |- ?f' ?a ?b n = _ => functional induction f' a b n; autorewrite with str_mod; auto | |- ?f' ?a ?b ?c n = _ => functional induction f' a b c n; autorewrite with str_mod; auto end. Function nats' (n:nat) : nat := match n with 0 => 1 | S p => S (nats' p) end. Definition nats := stroff nats'. Lemma nats_eqn_decomposed_proof : nats == 1::map S nats. unfold nats; apply ntheq_eqst; intro n; rewrite nth_stroff. functional induction nats' n. auto. rewrite Str_nth_S. rewrite Str_nth_map. rewrite nth_stroff. trivial. Qed. Lemma nats_eqn : nats == 1::map S nats. str_eqn_tac. Qed. Function fibs' (n:nat) : nat := match n with S ((S p) as q) => fibs' p + fibs' q | S 0 => 1 | 0 => 1 end. Definition fibs := stroff fibs'. Lemma fibs_eqn : fibs == 1::1::zipWith plus fibs (tl fibs). str_eqn_tac. Qed. Function dTimes' (x y:Stream nat) (n:nat) {struct n} : nat := match x, y, n with Cons x0 x', Cons y0 y', 0 => x0 * y0 | Cons x0 x', Cons y0 y', S p => (dTimes' x' y p) + (dTimes' x y' p) end. Definition dTimes a b := stroff (dTimes' a b). Lemma dTimes_eqn : forall a b, dTimes a b == hd a * hd b :: zipWith plus (dTimes (tl a) b) (dTimes a (tl b)). str_eqn_tac. Qed.