(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)
(* Contribution to the Coq Library   V6.3 (July 1999)                    *)
(****************************************************************)
(*           The Calculus of Inductive Constructions            *)
(*                       COQ v5.10                              *)
(*                                                              *)
(* Laurent Arditi.  Laboratoire I3S. CNRS ura 1376.             *)
(* Universite de Nice - Sophia Antipolis                        *)
(* arditi@unice.fr, http://wwwi3s.unice.fr/~arditi/lolo.html    *)
(*                                                              *)
(* date: july 1995                                              *)
(* file: Definitions.v                                          *)
(* contents: PROOF OF A SEQUENTIAL MULTIPLIER. Definitions of   *)
(* auxilliary functions, axioms and the register-functions.     *)
(****************************************************************)
(****************************************************************)
(* Definitions des operateurs utilises (lowbit et highs) des registres (R1 et R2) et des lemmes sur les longueurs des registres *)
Require Export BV.
Require Export Adder.
Definition Mux := If BV.
Hint Unfold Mux.
Definition lowbit (l : list bool) :=
match l with
| nil => false
| b :: _ => b
end.
Definition highs (l : list bool) :=
match l with
| nil => nil (A:=bool)
| _ :: v => v
end.
simple induction v. intro. absurd (nil <> nilbv); unfold not in |- *; auto with arith.
intros. simpl in |- *. rewrite (trunc_O bool). trivial with arith.
Qed.
intros. unfold abit in |- *. unfold elemlist in |- *. rewrite strip_O.
apply lowbit_is_trunc. exact H.
Qed.
simple induction v. simpl in |- *. auto with arith.
intros. simpl in |- *. rewrite (strip_cons_S bool). rewrite strip_O. trivial with arith.
Qed.
intros. rewrite lowbit_is_trunc. rewrite highs_is_strip.
rewrite (app_trunc_strip bool). trivial with arith. exact H.
Qed.
intros. rewrite highs_is_strip.
rewrite (length_strip bool). apply minus_n_SO.
apply (v_not_nil_length bool). exact H.
Qed.
unfold abit in |- *. exact (length_elemlist bool).
Qed.
(****************************************************************)
(* Defintitions des variables et leurs contraintes *)
Parameter size : nat. (* La taille des mots *)
Parameter V1 : BV. (* Les deux entrees *)
Parameter V2 : BV.
generalize size_not_O. elim size. intro. absurd (0 <> 0); unfold not in |- *; auto with arith.
intros. apply le_n_S. auto with arith. Qed. Hint Resolve le_SO_size.
rewrite length_V1_size. auto with arith. Qed. Hint Resolve length_V1.
rewrite length_V2_size. auto with arith. Qed. Hint Resolve length_V2.
transitivity size; auto with arith. Qed.
apply (not_nil bool). auto with arith. Qed. Hint Resolve V1_not_nil.
apply (not_nil bool). auto with arith. Qed. Hint Resolve V2_not_nil.
apply (le_SO_length_v bool). auto with arith. Qed. Hint Resolve le_SO_length_V1.
(****************************************************************)
(* Les registres: *)
Fixpoint R1 (st : nat) : BV :=
match st return BV with
| O => V1
| S t =>
appbv (highs (R1 t))
(Mux (lowbit (R1 t))
(consbv (lowbit (BV_full_adder_sum (R2 t) V2 false)) nilbv)
(consbv (lowbit (R2 t)) nilbv))
end
with R2 (st : nat) : BV :=
match st return BV with
| O => BV_null size
| S t =>
appbv
(highs
(Mux (lowbit (R1 t)) (BV_full_adder_sum (R2 t) V2 false) (R2 t)))
(Mux (lowbit (R1 t))
(consbv (BV_full_adder_carry (R2 t) V2 false) nilbv)
(consbv false nilbv))
end.
auto with arith. Qed.
auto with arith. Qed.
simple induction t. auto with arith.
intros. rewrite R1_eq2. rewrite (length_app bool).
unfold Mux in |- *. rewrite (F_If BV nat _ _ _ (@length bool)). simpl in |- *. rewrite If_eq.
rewrite highs_is_strip. rewrite (length_strip bool). unfold lengthbv in H.
rewrite H. symmetry  in |- *. rewrite plus_comm. apply le_plus_minus. auto with arith.
apply le_Sn_le; auto with arith.
unfold lengthbv in H. rewrite H. auto with arith.
apply le_Sn_le. exact H0.
Qed. Hint Resolve length_R1.
simple induction t. simpl in |- *.
unfold lengthbv, BV_null in |- *. rewrite (length_list_const bool). trivial with arith.
unfold lengthbv in |- *. intros. rewrite R2_eq2.
rewrite (length_app bool). unfold Mux, consbv.
rewrite (F_If BV BV _ _ _ highs).
rewrite (F_If BV nat _ _ _ (@length bool)).
rewrite highs_is_strip. rewrite (length_strip bool).
rewrite length_BV_full_adder_sum. unfold lengthbv in |- *.
rewrite H. rewrite highs_is_strip. rewrite (length_strip bool).
rewrite H. rewrite If_eq. rewrite (F_If BV nat _ _ _ (@length bool)). simpl in |- *.
rewrite If_eq. symmetry  in |- *. rewrite plus_comm. apply le_plus_minus. auto with arith.
auto with arith. rewrite H. auto with arith.
apply le_Sn_le; exact H0. apply le_Sn_le; exact H0.
unfold lengthbv in |- *. rewrite H. auto with arith. apply le_Sn_le; exact H0.
rewrite length_BV_full_adder_sum.
unfold lengthbv in |- *. rewrite H. auto with arith. apply le_Sn_le; exact H0.
unfold lengthbv in |- *. rewrite H. auto with arith. apply le_Sn_le; exact H0.
Qed. Hint Resolve length_R2.

Lemma R1_never_nil : forall t : nat, t <= size -> R1 t <> nilbv.