diff options
Diffstat (limited to 'contrib')
30 files changed, 6192 insertions, 6165 deletions
diff --git a/contrib/cc/CCSolve.v b/contrib/cc/CCSolve.v index 30622aeaa..c80ba16ec 100644 --- a/contrib/cc/CCSolve.v +++ b/contrib/cc/CCSolve.v @@ -8,13 +8,15 @@ (* $Id$ *) -Tactic Definition CCsolve := - Repeat (Match Context With - [ H: ?1 |- ?2] -> - Let Heq = FreshId "Heq" In - (Assert Heq:(?2==?1);[Congruence|(Rewrite Heq;Exact H)]) - |[ H: ?1; G: ?2 -> ?3 |- ?] -> - Let Heq = FreshId "Heq" In - (Assert Heq:(?2==?1) ;[Congruence| - (Rewrite Heq in G;Generalize (G H);Clear G;Intro G)])). - +Ltac CCsolve := + repeat + match goal with + | H:?X1 |- ?X2 => + let Heq := fresh "Heq" in + (assert (Heq : X2 = X1); [ congruence | rewrite Heq; exact H ]) + | H:?X1,G:(?X2 -> ?X3) |- _ => + let Heq := fresh "Heq" in + (assert (Heq : X2 = X1); + [ congruence + | rewrite Heq in G; generalize (G H); clear G; intro G ]) + end. diff --git a/contrib/correctness/ArrayPermut.v b/contrib/correctness/ArrayPermut.v index 55259b943..4223a0547 100644 --- a/contrib/correctness/ArrayPermut.v +++ b/contrib/correctness/ArrayPermut.v @@ -15,11 +15,11 @@ (* Definition and properties *) (****************************************************************************) -Require ProgInt. -Require Arrays. +Require Import ProgInt. +Require Import Arrays. Require Export Exchange. -Require Omega. +Require Import Omega. Set Implicit Arguments. @@ -27,18 +27,16 @@ Set Implicit Arguments. * transpositions i.e. exchange of two elements. *) -Inductive permut [n:Z; A:Set] : (array n A)->(array n A)->Prop := - exchange_is_permut : - (t,t':(array n A))(i,j:Z)(exchange t t' i j) -> (permut t t') - | permut_refl : - (t:(array n A))(permut t t) - | permut_sym : - (t,t':(array n A))(permut t t') -> (permut t' t) - | permut_trans : - (t,t',t'':(array n A)) - (permut t t') -> (permut t' t'') -> (permut t t''). +Inductive permut (n:Z) (A:Set) : array n A -> array n A -> Prop := + | exchange_is_permut : + forall (t t':array n A) (i j:Z), exchange t t' i j -> permut t t' + | permut_refl : forall t:array n A, permut t t + | permut_sym : forall t t':array n A, permut t t' -> permut t' t + | permut_trans : + forall t t' t'':array n A, permut t t' -> permut t' t'' -> permut t t''. -Hints Resolve exchange_is_permut permut_refl permut_sym permut_trans : v62 datatypes. +Hint Resolve exchange_is_permut permut_refl permut_sym permut_trans: v62 + datatypes. (* We also define the permutation on a segment of an array, "sub_permut", * the other parts of the array being unchanged @@ -47,137 +45,131 @@ Hints Resolve exchange_is_permut permut_refl permut_sym permut_trans : v62 datat * transpositions on the given segment. *) -Inductive sub_permut [n:Z; A:Set; g,d:Z] : (array n A)->(array n A)->Prop := - exchange_is_sub_permut : - (t,t':(array n A))(i,j:Z)`g <= i <= d` -> `g <= j <= d` - -> (exchange t t' i j) -> (sub_permut g d t t') - | sub_permut_refl : - (t:(array n A))(sub_permut g d t t) - | sub_permut_sym : - (t,t':(array n A))(sub_permut g d t t') -> (sub_permut g d t' t) - | sub_permut_trans : - (t,t',t'':(array n A)) - (sub_permut g d t t') -> (sub_permut g d t' t'') - -> (sub_permut g d t t''). - -Hints Resolve exchange_is_sub_permut sub_permut_refl sub_permut_sym sub_permut_trans - : v62 datatypes. +Inductive sub_permut (n:Z) (A:Set) (g d:Z) : +array n A -> array n A -> Prop := + | exchange_is_sub_permut : + forall (t t':array n A) (i j:Z), + (g <= i <= d)%Z -> + (g <= j <= d)%Z -> exchange t t' i j -> sub_permut g d t t' + | sub_permut_refl : forall t:array n A, sub_permut g d t t + | sub_permut_sym : + forall t t':array n A, sub_permut g d t t' -> sub_permut g d t' t + | sub_permut_trans : + forall t t' t'':array n A, + sub_permut g d t t' -> sub_permut g d t' t'' -> sub_permut g d t t''. + +Hint Resolve exchange_is_sub_permut sub_permut_refl sub_permut_sym + sub_permut_trans: v62 datatypes. (* To express that some parts of arrays are equal we introduce the * property "array_id" which says that a segment is the same on two * arrays. *) -Definition array_id := [n:Z][A:Set][t,t':(array n A)][g,d:Z] - (i:Z) `g <= i <= d` -> #t[i] = #t'[i]. +Definition array_id (n:Z) (A:Set) (t t':array n A) + (g d:Z) := forall i:Z, (g <= i <= d)%Z -> #t [i] = #t' [i]. (* array_id is an equivalence relation *) -Lemma array_id_refl : - (n:Z)(A:Set)(t:(array n A))(g,d:Z) - (array_id t t g d). +Lemma array_id_refl : + forall (n:Z) (A:Set) (t:array n A) (g d:Z), array_id t t g d. Proof. -Unfold array_id. -Auto with datatypes. -Save. +unfold array_id in |- *. +auto with datatypes. +Qed. -Hints Resolve array_id_refl : v62 datatypes. +Hint Resolve array_id_refl: v62 datatypes. Lemma array_id_sym : - (n:Z)(A:Set)(t,t':(array n A))(g,d:Z) - (array_id t t' g d) - -> (array_id t' t g d). + forall (n:Z) (A:Set) (t t':array n A) (g d:Z), + array_id t t' g d -> array_id t' t g d. Proof. -Unfold array_id. Intros. -Symmetry; Auto with datatypes. -Save. +unfold array_id in |- *. intros. +symmetry in |- *; auto with datatypes. +Qed. -Hints Resolve array_id_sym : v62 datatypes. +Hint Resolve array_id_sym: v62 datatypes. Lemma array_id_trans : - (n:Z)(A:Set)(t,t',t'':(array n A))(g,d:Z) - (array_id t t' g d) - -> (array_id t' t'' g d) - -> (array_id t t'' g d). + forall (n:Z) (A:Set) (t t' t'':array n A) (g d:Z), + array_id t t' g d -> array_id t' t'' g d -> array_id t t'' g d. Proof. -Unfold array_id. Intros. -Apply trans_eq with y:=#t'[i]; Auto with datatypes. -Save. +unfold array_id in |- *. intros. +apply trans_eq with (y := #t' [i]); auto with datatypes. +Qed. -Hints Resolve array_id_trans: v62 datatypes. +Hint Resolve array_id_trans: v62 datatypes. (* Outside the segment [g,d] the elements are equal *) Lemma sub_permut_id : - (n:Z)(A:Set)(t,t':(array n A))(g,d:Z) - (sub_permut g d t t') -> - (array_id t t' `0` `g-1`) /\ (array_id t t' `d+1` `n-1`). + forall (n:Z) (A:Set) (t t':array n A) (g d:Z), + sub_permut g d t t' -> + array_id t t' 0 (g - 1) /\ array_id t t' (d + 1) (n - 1). Proof. -Intros n A t t' g d. Induction 1; Intros. -Elim H2; Intros. -Unfold array_id; Split; Intros. -Apply H7; Omega. -Apply H7; Omega. -Auto with datatypes. -Decompose [and] H1; Auto with datatypes. -Decompose [and] H1; Decompose [and] H3; EAuto with datatypes. -Save. - -Hints Resolve sub_permut_id. +intros n A t t' g d. simple induction 1; intros. +elim H2; intros. +unfold array_id in |- *; split; intros. +apply H7; omega. +apply H7; omega. +auto with datatypes. +decompose [and] H1; auto with datatypes. +decompose [and] H1; decompose [and] H3; eauto with datatypes. +Qed. + +Hint Resolve sub_permut_id. Lemma sub_permut_eq : - (n:Z)(A:Set)(t,t':(array n A))(g,d:Z) - (sub_permut g d t t') -> - (i:Z) (`0<=i<g` \/ `d<i<n`) -> #t[i]=#t'[i]. + forall (n:Z) (A:Set) (t t':array n A) (g d:Z), + sub_permut g d t t' -> + forall i:Z, (0 <= i < g)%Z \/ (d < i < n)%Z -> #t [i] = #t' [i]. Proof. -Intros n A t t' g d Htt' i Hi. -Elim (sub_permut_id Htt'). Unfold array_id. -Intros. -Elim Hi; [ Intro; Apply H; Omega | Intro; Apply H0; Omega ]. -Save. +intros n A t t' g d Htt' i Hi. +elim (sub_permut_id Htt'). unfold array_id in |- *. +intros. +elim Hi; [ intro; apply H; omega | intro; apply H0; omega ]. +Qed. (* sub_permut is a particular case of permutation *) Lemma sub_permut_is_permut : - (n:Z)(A:Set)(t,t':(array n A))(g,d:Z) - (sub_permut g d t t') -> - (permut t t'). + forall (n:Z) (A:Set) (t t':array n A) (g d:Z), + sub_permut g d t t' -> permut t t'. Proof. -Intros n A t t' g d. Induction 1; Intros; EAuto with datatypes. -Save. +intros n A t t' g d. simple induction 1; intros; eauto with datatypes. +Qed. -Hints Resolve sub_permut_is_permut. +Hint Resolve sub_permut_is_permut. (* If we have a sub-permutation on an empty segment, then we have a * sub-permutation on any segment. *) Lemma sub_permut_void : - (N:Z)(A:Set)(t,t':(array N A)) - (g,g',d,d':Z) `d < g` - -> (sub_permut g d t t') -> (sub_permut g' d' t t'). + forall (N:Z) (A:Set) (t t':array N A) (g g' d d':Z), + (d < g)%Z -> sub_permut g d t t' -> sub_permut g' d' t t'. Proof. -Intros N A t t' g g' d d' Hdg. -(Induction 1; Intros). -(Absurd `g <= d`; Omega). -Auto with datatypes. -Auto with datatypes. -EAuto with datatypes. -Save. +intros N A t t' g g' d d' Hdg. +simple induction 1; intros. +absurd (g <= d)%Z; omega. +auto with datatypes. +auto with datatypes. +eauto with datatypes. +Qed. (* A sub-permutation on a segment may be extended to any segment that * contains the first one. *) Lemma sub_permut_extension : - (N:Z)(A:Set)(t,t':(array N A)) - (g,g',d,d':Z) `g' <= g` -> `d <= d'` - -> (sub_permut g d t t') -> (sub_permut g' d' t t'). + forall (N:Z) (A:Set) (t t':array N A) (g g' d d':Z), + (g' <= g)%Z -> (d <= d')%Z -> sub_permut g d t t' -> sub_permut g' d' t t'. Proof. -Intros N A t t' g g' d d' Hgg' Hdd'. -(Induction 1; Intros). -Apply exchange_is_sub_permut with i:=i j:=j; [ Omega | Omega | Assumption ]. -Auto with datatypes. -Auto with datatypes. -EAuto with datatypes. -Save. +intros N A t t' g g' d d' Hgg' Hdd'. +simple induction 1; intros. +apply exchange_is_sub_permut with (i := i) (j := j); + [ omega | omega | assumption ]. +auto with datatypes. +auto with datatypes. +eauto with datatypes. +Qed.
\ No newline at end of file diff --git a/contrib/correctness/Arrays.v b/contrib/correctness/Arrays.v index 40b19e74f..000a5c913 100644 --- a/contrib/correctness/Arrays.v +++ b/contrib/correctness/Arrays.v @@ -39,37 +39,40 @@ Parameter array : Z -> Set -> Set. (* Functions to create, access and modify arrays *) -Parameter new : (n:Z)(T:Set) T -> (array n T). +Parameter new : forall (n:Z) (T:Set), T -> array n T. -Parameter access : (n:Z)(T:Set) (array n T) -> Z -> T. +Parameter access : forall (n:Z) (T:Set), array n T -> Z -> T. -Parameter store : (n:Z)(T:Set) (array n T) -> Z -> T -> (array n T). +Parameter store : forall (n:Z) (T:Set), array n T -> Z -> T -> array n T. (* Axioms *) -Axiom new_def : (n:Z)(T:Set)(v0:T) - (i:Z) `0<=i<n` -> (access (new n v0) i) = v0. +Axiom + new_def : + forall (n:Z) (T:Set) (v0:T) (i:Z), + (0 <= i < n)%Z -> access (new n v0) i = v0. -Axiom store_def_1 : (n:Z)(T:Set)(t:(array n T))(v:T) - (i:Z) `0<=i<n` -> - (access (store t i v) i) = v. +Axiom + store_def_1 : + forall (n:Z) (T:Set) (t:array n T) (v:T) (i:Z), + (0 <= i < n)%Z -> access (store t i v) i = v. -Axiom store_def_2 : (n:Z)(T:Set)(t:(array n T))(v:T) - (i:Z)(j:Z) `0<=i<n` -> `0<=j<n` -> - `i <> j` -> - (access (store t i v) j) = (access t j). +Axiom + store_def_2 : + forall (n:Z) (T:Set) (t:array n T) (v:T) (i j:Z), + (0 <= i < n)%Z -> + (0 <= j < n)%Z -> i <> j -> access (store t i v) j = access t j. -Hints Resolve new_def store_def_1 store_def_2 : datatypes v62. +Hint Resolve new_def store_def_1 store_def_2: datatypes v62. (* A tactic to simplify access in arrays *) -Tactic Definition ArrayAccess i j H := - Elim (Z_eq_dec i j); [ - Intro H; Rewrite H; Rewrite store_def_1 - | Intro H; Rewrite store_def_2; [ Idtac | Idtac | Idtac | Exact H ] ]. +Ltac array_access i j H := + elim (Z_eq_dec i j); + [ intro H; rewrite H; rewrite store_def_1 + | intro H; rewrite store_def_2; [ idtac | idtac | idtac | exact H ] ]. (* Symbolic notation for access *) -Notation "# t [ c ]" := (access t c) (at level 0, t ident) - V8only (at level 0, t at level 0). +Notation "# t [ c ]" := (access t c) (at level 0, t at level 0).
\ No newline at end of file diff --git a/contrib/correctness/Correctness.v b/contrib/correctness/Correctness.v index 8f3f90b95..cc36e829f 100644 --- a/contrib/correctness/Correctness.v +++ b/contrib/correctness/Correctness.v @@ -22,4 +22,4 @@ Require Export Arrays. (* Token "'". -*) +*)
\ No newline at end of file diff --git a/contrib/correctness/Exchange.v b/contrib/correctness/Exchange.v index 85c19b48b..8016a2927 100644 --- a/contrib/correctness/Exchange.v +++ b/contrib/correctness/Exchange.v @@ -15,80 +15,81 @@ (* Definition and properties *) (****************************************************************************) -Require ProgInt. -Require Arrays. +Require Import ProgInt. +Require Import Arrays. Set Implicit Arguments. (* Definition *) -Inductive exchange [n:Z; A:Set; t,t':(array n A); i,j:Z] : Prop := - exchange_c : - `0<=i<n` -> `0<=j<n` -> - (#t[i] = #t'[j]) -> - (#t[j] = #t'[i]) -> - ((k:Z)`0<=k<n` -> `k<>i` -> `k<>j` -> #t[k] = #t'[k]) -> - (exchange t t' i j). +Inductive exchange (n:Z) (A:Set) (t t':array n A) (i j:Z) : Prop := + exchange_c : + (0 <= i < n)%Z -> + (0 <= j < n)%Z -> + #t [i] = #t' [j] -> + #t [j] = #t' [i] -> + (forall k:Z, (0 <= k < n)%Z -> k <> i -> k <> j -> #t [k] = #t' [k]) -> + exchange t t' i j. (* Properties about exchanges *) -Lemma exchange_1 : (n:Z)(A:Set)(t:(array n A)) - (i,j:Z) `0<=i<n` -> `0<=j<n` -> - (access (store (store t i #t[j]) j #t[i]) i) = #t[j]. +Lemma exchange_1 : + forall (n:Z) (A:Set) (t:array n A) (i j:Z), + (0 <= i < n)%Z -> + (0 <= j < n)%Z -> #(store (store t i #t [j]) j #t [i]) [i] = #t [j]. Proof. -Intros n A t i j H_i H_j. -Case (dec_eq j i). -Intro eq_i_j. Rewrite eq_i_j. -Auto with datatypes. -Intro not_j_i. -Rewrite (store_def_2 (store t i #t[j]) #t[i] H_j H_i not_j_i). -Auto with datatypes. -Save. +intros n A t i j H_i H_j. +case (dec_eq j i). +intro eq_i_j. rewrite eq_i_j. +auto with datatypes. +intro not_j_i. +rewrite (store_def_2 (store t i #t [j]) #t [i] H_j H_i not_j_i). +auto with datatypes. +Qed. -Hints Resolve exchange_1 : v62 datatypes. +Hint Resolve exchange_1: v62 datatypes. Lemma exchange_proof : - (n:Z)(A:Set)(t:(array n A)) - (i,j:Z) `0<=i<n` -> `0<=j<n` -> - (exchange (store (store t i (access t j)) j (access t i)) t i j). + forall (n:Z) (A:Set) (t:array n A) (i j:Z), + (0 <= i < n)%Z -> + (0 <= j < n)%Z -> exchange (store (store t i #t [j]) j #t [i]) t i j. Proof. -Intros n A t i j H_i H_j. -Apply exchange_c; Auto with datatypes. -Intros k H_k not_k_i not_k_j. -Cut ~j=k; Auto with datatypes. Intro not_j_k. -Rewrite (store_def_2 (store t i (access t j)) (access t i) H_j H_k not_j_k). -Auto with datatypes. -Save. +intros n A t i j H_i H_j. +apply exchange_c; auto with datatypes. +intros k H_k not_k_i not_k_j. +cut (j <> k); auto with datatypes. intro not_j_k. +rewrite (store_def_2 (store t i #t [j]) #t [i] H_j H_k not_j_k). +auto with datatypes. +Qed. -Hints Resolve exchange_proof : v62 datatypes. +Hint Resolve exchange_proof: v62 datatypes. Lemma exchange_sym : - (n:Z)(A:Set)(t,t':(array n A))(i,j:Z) - (exchange t t' i j) -> (exchange t' t i j). + forall (n:Z) (A:Set) (t t':array n A) (i j:Z), + exchange t t' i j -> exchange t' t i j. Proof. -Intros n A t t' i j H1. -Elim H1. Clear H1. Intros. -Constructor 1; Auto with datatypes. -Intros. Rewrite (H3 k); Auto with datatypes. -Save. +intros n A t t' i j H1. +elim H1. clear H1. intros. +constructor 1; auto with datatypes. +intros. rewrite (H3 k); auto with datatypes. +Qed. -Hints Resolve exchange_sym : v62 datatypes. +Hint Resolve exchange_sym: v62 datatypes. Lemma exchange_id : - (n:Z)(A:Set)(t,t':(array n A))(i,j:Z) - (exchange t t' i j) -> - i=j -> - (k:Z) `0 <= k < n` -> (access t k)=(access t' k). + forall (n:Z) (A:Set) (t t':array n A) (i j:Z), + exchange t t' i j -> + i = j -> forall k:Z, (0 <= k < n)%Z -> #t [k] = #t' [k]. Proof. -Intros n A t t' i j Hex Heq k Hk. -Elim Hex. Clear Hex. Intros. -Rewrite Heq in H1. Rewrite Heq in H2. -Case (Z_eq_dec k j). - Intro Heq'. Rewrite Heq'. Assumption. - Intro Hnoteq. Apply (H3 k); Auto with datatypes. Rewrite Heq. Assumption. -Save. - -Hints Resolve exchange_id : v62 datatypes. +intros n A t t' i j Hex Heq k Hk. +elim Hex. clear Hex. intros. +rewrite Heq in H1. rewrite Heq in H2. +case (Z_eq_dec k j). + intro Heq'. rewrite Heq'. assumption. + intro Hnoteq. apply (H3 k); auto with datatypes. rewrite Heq. assumption. +Qed. + +Hint Resolve exchange_id: v62 datatypes.
\ No newline at end of file diff --git a/contrib/correctness/ProgBool.v b/contrib/correctness/ProgBool.v index 364cc8d6a..6563fb68a 100644 --- a/contrib/correctness/ProgBool.v +++ b/contrib/correctness/ProgBool.v @@ -10,57 +10,57 @@ (* $Id$ *) -Require ZArith. +Require Import ZArith. Require Export Bool_nat. Require Export Sumbool. Definition annot_bool : - (b:bool) { b':bool | if b' then b=true else b=false }. + forall b:bool, {b' : bool | if b' then b = true else b = false}. Proof. -Intro b. -Exists b. Case b; Trivial. -Save. +intro b. +exists b. case b; trivial. +Qed. (* Logical connectives *) -Definition spec_and := [A,B,C,D:Prop][b:bool]if b then A /\ C else B \/ D. +Definition spec_and (A B C D:Prop) (b:bool) := if b then A /\ C else B \/ D. Definition prog_bool_and : - (Q1,Q2:bool->Prop) (sig bool Q1) -> (sig bool Q2) - -> { b:bool | if b then (Q1 true) /\ (Q2 true) - else (Q1 false) \/ (Q2 false) }. + forall Q1 Q2:bool -> Prop, + sig Q1 -> + sig Q2 -> + {b : bool | if b then Q1 true /\ Q2 true else Q1 false \/ Q2 false}. Proof. -Intros Q1 Q2 H1 H2. -Elim H1. Intro b1. Elim H2. Intro b2. -Case b1; Case b2; Intros. -Exists true; Auto. -Exists false; Auto. Exists false; Auto. Exists false; Auto. -Save. +intros Q1 Q2 H1 H2. +elim H1. intro b1. elim H2. intro b2. +case b1; case b2; intros. +exists true; auto. +exists false; auto. exists false; auto. exists false; auto. +Qed. -Definition spec_or := [A,B,C,D:Prop][b:bool]if b then A \/ C else B /\ D. +Definition spec_or (A B C D:Prop) (b:bool) := if b then A \/ C else B /\ D. Definition prog_bool_or : - (Q1,Q2:bool->Prop) (sig bool Q1) -> (sig bool Q2) - -> { b:bool | if b then (Q1 true) \/ (Q2 true) - else (Q1 false) /\ (Q2 false) }. + forall Q1 Q2:bool -> Prop, + sig Q1 -> + sig Q2 -> + {b : bool | if b then Q1 true \/ Q2 true else Q1 false /\ Q2 false}. Proof. -Intros Q1 Q2 H1 H2. -Elim H1. Intro b1. Elim H2. Intro b2. -Case b1; Case b2; Intros. -Exists true; Auto. Exists true; Auto. Exists true; Auto. -Exists false; Auto. -Save. +intros Q1 Q2 H1 H2. +elim H1. intro b1. elim H2. intro b2. +case b1; case b2; intros. +exists true; auto. exists true; auto. exists true; auto. +exists false; auto. +Qed. -Definition spec_not:= [A,B:Prop][b:bool]if b then B else A. +Definition spec_not (A B:Prop) (b:bool) := if b then B else A. Definition prog_bool_not : - (Q:bool->Prop) (sig bool Q) - -> { b:bool | if b then (Q false) else (Q true) }. + forall Q:bool -> Prop, sig Q -> {b : bool | if b then Q false else Q true}. Proof. -Intros Q H. -Elim H. Intro b. -Case b; Intro. -Exists false; Auto. Exists true; Auto. -Save. - +intros Q H. +elim H. intro b. +case b; intro. +exists false; auto. exists true; auto. +Qed. diff --git a/contrib/correctness/ProgInt.v b/contrib/correctness/ProgInt.v index ec46e2de6..470162ca3 100644 --- a/contrib/correctness/ProgInt.v +++ b/contrib/correctness/ProgInt.v @@ -13,7 +13,7 @@ Require Export ZArith. Require Export ZArith_dec. -Theorem Znotzero : (x:Z){`x<>0`}+{`x=0`}. +Theorem Znotzero : forall x:Z, {x <> 0%Z} + {x = 0%Z}. Proof. -Intro x. Elim (Z_eq_dec x `0`) ; Auto. -Save. +intro x. elim (Z_eq_dec x 0); auto. +Qed.
\ No newline at end of file diff --git a/contrib/correctness/Sorted.v b/contrib/correctness/Sorted.v index 7e656ae1b..0dafe1010 100644 --- a/contrib/correctness/Sorted.v +++ b/contrib/correctness/Sorted.v @@ -11,188 +11,192 @@ (* $Id$ *) Require Export Arrays. -Require ArrayPermut. +Require Import ArrayPermut. -Require ZArithRing. -Require Omega. -V7only [Import Z_scope.]. +Require Import ZArithRing. +Require Import Omega. Open Local Scope Z_scope. Set Implicit Arguments. (* Definition *) -Definition sorted_array := - [N:Z][A:(array N Z)][deb:Z][fin:Z] - `deb<=fin` -> (x:Z) `x>=deb` -> `x<fin` -> (Zle #A[x] #A[`x+1`]). +Definition sorted_array (N:Z) (A:array N Z) (deb fin:Z) := + deb <= fin -> forall x:Z, x >= deb -> x < fin -> #A [x] <= #A [x + 1]. (* Elements of a sorted sub-array are in increasing order *) (* one element and the next one *) Lemma sorted_elements_1 : - (N:Z)(A:(array N Z))(n:Z)(m:Z) - (sorted_array A n m) - -> (k:Z)`k>=n` - -> (i:Z) `0<=i` -> `k+i<=m` - -> (Zle (access A k) (access A `k+i`)). + forall (N:Z) (A:array N Z) (n m:Z), + sorted_array A n m -> + forall k:Z, + k >= n -> forall i:Z, 0 <= i -> k + i <= m -> #A [k] <= #A [k + i]. Proof. -Intros N A n m H_sorted k H_k i H_i. -Pattern i. Apply natlike_ind. -Intro. -Replace `k+0` with k; Omega. (*** Ring `k+0` => BUG ***) +intros N A n m H_sorted k H_k i H_i. +pattern i in |- *. apply natlike_ind. +intro. +replace (k + 0) with k; omega. (*** Ring `k+0` => BUG ***) -Intros. -Apply Zle_trans with m:=(access A `k+x`). -Apply H0 ; Omega. +intros. +apply Zle_trans with (m := #A [k + x]). +apply H0; omega. -Unfold Zs. -Replace `k+(x+1)` with `(k+x)+1`. -Unfold sorted_array in H_sorted. -Apply H_sorted ; Omega. +unfold Zsucc in |- *. +replace (k + (x + 1)) with (k + x + 1). +unfold sorted_array in H_sorted. +apply H_sorted; omega. -Omega. +omega. -Assumption. -Save. +assumption. +Qed. (* one element and any of the following *) Lemma sorted_elements : - (N:Z)(A:(array N Z))(n:Z)(m:Z)(k:Z)(l:Z) - (sorted_array A n m) - -> `k>=n` -> `l<N` -> `k<=l` -> `l<=m` - -> (Zle (access A k) (access A l)). + forall (N:Z) (A:array N Z) (n m k l:Z), + sorted_array A n m -> + k >= n -> l < N -> k <= l -> l <= m -> #A [k] <= #A [l]. Proof. -Intros. -Replace l with `k+(l-k)`. -Apply sorted_elements_1 with n:=n m:=m; [Assumption | Omega | Omega | Omega]. -Omega. -Save. +intros. +replace l with (k + (l - k)). +apply sorted_elements_1 with (n := n) (m := m); + [ assumption | omega | omega | omega ]. +omega. +Qed. -Hints Resolve sorted_elements : datatypes v62. +Hint Resolve sorted_elements: datatypes v62. (* A sub-array of a sorted array is sorted *) -Lemma sub_sorted_array : (N:Z)(A:(array N Z))(deb:Z)(fin:Z)(i:Z)(j:Z) - (sorted_array A deb fin) -> - (`i>=deb` -> `j<=fin` -> `i<=j` -> (sorted_array A i j)). +Lemma sub_sorted_array : + forall (N:Z) (A:array N Z) (deb fin i j:Z), + sorted_array A deb fin -> + i >= deb -> j <= fin -> i <= j -> sorted_array A i j. Proof. -Unfold sorted_array. -Intros. -Apply H ; Omega. -Save. +unfold sorted_array in |- *. +intros. +apply H; omega. +Qed. -Hints Resolve sub_sorted_array : datatypes v62. +Hint Resolve sub_sorted_array: datatypes v62. (* Extension on the left of the property of being sorted *) -Lemma left_extension : (N:Z)(A:(array N Z))(i:Z)(j:Z) - `i>0` -> `j<N` -> (sorted_array A i j) - -> (Zle #A[`i-1`] #A[i]) -> (sorted_array A `i-1` j). +Lemma left_extension : + forall (N:Z) (A:array N Z) (i j:Z), + i > 0 -> + j < N -> + sorted_array A i j -> #A [i - 1] <= #A [i] -> sorted_array A (i - 1) j. Proof. -(Intros; Unfold sorted_array ; Intros). -Elim (Z_ge_lt_dec x i). (* (`x >= i`) + (`x < i`) *) -Intro Hcut. -Apply H1 ; Omega. +intros; unfold sorted_array in |- *; intros. +elim (Z_ge_lt_dec x i). (* (`x >= i`) + (`x < i`) *) +intro Hcut. +apply H1; omega. -Intro Hcut. -Replace x with `i-1`. -Replace `i-1+1` with i ; [Assumption | Omega]. +intro Hcut. +replace x with (i - 1). +replace (i - 1 + 1) with i; [ assumption | omega ]. -Omega. -Save. +omega. +Qed. (* Extension on the right *) -Lemma right_extension : (N:Z)(A:(array N Z))(i:Z)(j:Z) - `i>=0` -> `j<N-1` -> (sorted_array A i j) - -> (Zle #A[j] #A[`j+1`]) -> (sorted_array A i `j+1`). +Lemma right_extension : + forall (N:Z) (A:array N Z) (i j:Z), + i >= 0 -> + j < N - 1 -> + sorted_array A i j -> #A [j] <= #A [j + 1] -> sorted_array A i (j + 1). Proof. -(Intros; Unfold sorted_array ; Intros). -Elim (Z_lt_ge_dec x j). -Intro Hcut. -Apply H1 ; Omega. +intros; unfold sorted_array in |- *; intros. +elim (Z_lt_ge_dec x j). +intro Hcut. +apply H1; omega. -Intro HCut. -Replace x with j ; [Assumption | Omega]. -Save. +intro HCut. +replace x with j; [ assumption | omega ]. +Qed. (* Substitution of the leftmost value by a smaller value *) -Lemma left_substitution : - (N:Z)(A:(array N Z))(i:Z)(j:Z)(v:Z) - `i>=0` -> `j<N` -> (sorted_array A i j) - -> (Zle v #A[i]) - -> (sorted_array (store A i v) i j). +Lemma left_substitution : + forall (N:Z) (A:array N Z) (i j v:Z), + i >= 0 -> + j < N -> + sorted_array A i j -> v <= #A [i] -> sorted_array (store A i v) i j. Proof. -Intros N A i j v H_i H_j H_sorted H_v. -Unfold sorted_array ; Intros. - -Cut `x = i`\/`x > i`. -(Intro Hcut ; Elim Hcut ; Clear Hcut ; Intro). -Rewrite H2. -Rewrite store_def_1 ; Try Omega. -Rewrite store_def_2 ; Try Omega. -Apply Zle_trans with m:=(access A i) ; [Assumption | Apply H_sorted ; Omega]. - -(Rewrite store_def_2; Try Omega). -(Rewrite store_def_2; Try Omega). -Apply H_sorted ; Omega. -Omega. -Save. +intros N A i j v H_i H_j H_sorted H_v. +unfold sorted_array in |- *; intros. + +cut (x = i \/ x > i). +intro Hcut; elim Hcut; clear Hcut; intro. +rewrite H2. +rewrite store_def_1; try omega. +rewrite store_def_2; try omega. +apply Zle_trans with (m := #A [i]); [ assumption | apply H_sorted; omega ]. + +rewrite store_def_2; try omega. +rewrite store_def_2; try omega. +apply H_sorted; omega. +omega. +Qed. (* Substitution of the rightmost value by a larger value *) -Lemma right_substitution : - (N:Z)(A:(array N Z))(i:Z)(j:Z)(v:Z) - `i>=0` -> `j<N` -> (sorted_array A i j) - -> (Zle #A[j] v) - -> (sorted_array (store A j v) i j). +Lemma right_substitution : + forall (N:Z) (A:array N Z) (i j v:Z), + i >= 0 -> + j < N -> + sorted_array A i j -> #A [j] <= v -> sorted_array (store A j v) i j. Proof. -Intros N A i j v H_i H_j H_sorted H_v. -Unfold sorted_array ; Intros. - -Cut `x = j-1`\/`x < j-1`. -(Intro Hcut ; Elim Hcut ; Clear Hcut ; Intro). -Rewrite H2. -Replace `j-1+1` with j; [ Idtac | Omega ]. (*** Ring `j-1+1`. => BUG ***) -Rewrite store_def_2 ; Try Omega. -Rewrite store_def_1 ; Try Omega. -Apply Zle_trans with m:=(access A j). -Apply sorted_elements with n:=i m:=j ; Try Omega ; Assumption. -Assumption. - -(Rewrite store_def_2; Try Omega). -(Rewrite store_def_2; Try Omega). -Apply H_sorted ; Omega. - -Omega. -Save. +intros N A i j v H_i H_j H_sorted H_v. +unfold sorted_array in |- *; intros. + +cut (x = j - 1 \/ x < j - 1). +intro Hcut; elim Hcut; clear Hcut; intro. +rewrite H2. +replace (j - 1 + 1) with j; [ idtac | omega ]. (*** Ring `j-1+1`. => BUG ***) +rewrite store_def_2; try omega. +rewrite store_def_1; try omega. +apply Zle_trans with (m := #A [j]). +apply sorted_elements with (n := i) (m := j); try omega; assumption. +assumption. + +rewrite store_def_2; try omega. +rewrite store_def_2; try omega. +apply H_sorted; omega. + +omega. +Qed. (* Affectation outside of the sorted region *) -Lemma no_effect : - (N:Z)(A:(array N Z))(i:Z)(j:Z)(k:Z)(v:Z) - `i>=0` -> `j<N` -> (sorted_array A i j) - -> `0<=k<i`\/`j<k<N` - -> (sorted_array (store A k v) i j). +Lemma no_effect : + forall (N:Z) (A:array N Z) (i j k v:Z), + i >= 0 -> + j < N -> + sorted_array A i j -> + 0 <= k < i \/ j < k < N -> sorted_array (store A k v) i j. Proof. -Intros. -Unfold sorted_array ; Intros. -Rewrite store_def_2 ; Try Omega. -Rewrite store_def_2 ; Try Omega. -Apply H1 ; Assumption. -Save. - -Lemma sorted_array_id : (N:Z)(t1,t2:(array N Z))(g,d:Z) - (sorted_array t1 g d) -> (array_id t1 t2 g d) -> (sorted_array t2 g d). +intros. +unfold sorted_array in |- *; intros. +rewrite store_def_2; try omega. +rewrite store_def_2; try omega. +apply H1; assumption. +Qed. + +Lemma sorted_array_id : + forall (N:Z) (t1 t2:array N Z) (g d:Z), + sorted_array t1 g d -> array_id t1 t2 g d -> sorted_array t2 g d. Proof. -Intros N t1 t2 g d Hsorted Hid. -Unfold array_id in Hid. -Unfold sorted_array in Hsorted. Unfold sorted_array. -Intros Hgd x H1x H2x. -Rewrite <- (Hid x); [ Idtac | Omega ]. -Rewrite <- (Hid `x+1`); [ Idtac | Omega ]. -Apply Hsorted; Assumption. -Save. +intros N t1 t2 g d Hsorted Hid. +unfold array_id in Hid. +unfold sorted_array in Hsorted. unfold sorted_array in |- *. +intros Hgd x H1x H2x. +rewrite <- (Hid x); [ idtac | omega ]. +rewrite <- (Hid (x + 1)); [ idtac | omega ]. +apply Hsorted; assumption. +Qed.
\ No newline at end of file diff --git a/contrib/correctness/Tuples.v b/contrib/correctness/Tuples.v index f9a3b56b7..41ff10c04 100644 --- a/contrib/correctness/Tuples.v +++ b/contrib/correctness/Tuples.v @@ -12,95 +12,87 @@ (* Tuples *) -Definition tuple_1 := [X:Set]X. +Definition tuple_1 (X:Set) := X. Definition tuple_2 := prod. Definition Build_tuple_2 := pair. Definition proj_2_1 := fst. Definition proj_2_2 := snd. -Record tuple_3 [ T1,T2,T3 : Set ] : Set := - { proj_3_1 : T1 ; - proj_3_2 : T2 ; - proj_3_3 : T3 }. - -Record tuple_4 [ T1,T2,T3,T4 : Set ] : Set := - { proj_4_1 : T1 ; - proj_4_2 : T2 ; - proj_4_3 : T3 ; - proj_4_4 : T4 }. - -Record tuple_5 [ T1,T2,T3,T4,T5 : Set ] : Set := - { proj_5_1 : T1 ; - proj_5_2 : T2 ; - proj_5_3 : T3 ; - proj_5_4 : T4 ; - proj_5_5 : T5 }. - -Record tuple_6 [ T1,T2,T3,T4,T5,T6 : Set ] : Set := - { proj_6_1 : T1 ; - proj_6_2 : T2 ; - proj_6_3 : T3 ; - proj_6_4 : T4 ; - proj_6_5 : T5 ; - proj_6_6 : T6 }. - -Record tuple_7 [ T1,T2,T3,T4,T5,T6,T7 : Set ] : Set := - { proj_7_1 : T1 ; - proj_7_2 : T2 ; - proj_7_3 : T3 ; - proj_7_4 : T4 ; - proj_7_5 : T5 ; - proj_7_6 : T6 ; - proj_7_7 : T7 }. +Record tuple_3 (T1 T2 T3:Set) : Set := + {proj_3_1 : T1; proj_3_2 : T2; proj_3_3 : T3}. +Record tuple_4 (T1 T2 T3 T4:Set) : Set := + {proj_4_1 : T1; proj_4_2 : T2; proj_4_3 : T3; proj_4_4 : T4}. -(* Existentials *) - -Definition sig_1 := sig. -Definition exist_1 := exist. - -Inductive sig_2 [ T1,T2 : Set; P:T1->T2->Prop ] : Set := - exist_2 : (x1:T1)(x2:T2)(P x1 x2) -> (sig_2 T1 T2 P). - -Inductive sig_3 [ T1,T2,T3 : Set; P:T1->T2->T3->Prop ] : Set := - exist_3 : (x1:T1)(x2:T2)(x3:T3)(P x1 x2 x3) -> (sig_3 T1 T2 T3 P). +Record tuple_5 (T1 T2 T3 T4 T5:Set) : Set := + {proj_5_1 : T1; proj_5_2 : T2; proj_5_3 : T3; proj_5_4 : T4; proj_5_5 : T5}. +Record tuple_6 (T1 T2 T3 T4 T5 T6:Set) : Set := + {proj_6_1 : T1; + proj_6_2 : T2; + proj_6_3 : T3; + proj_6_4 : T4; + proj_6_5 : T5; + proj_6_6 : T6}. -Inductive sig_4 [ T1,T2,T3,T4 : Set; - P:T1->T2->T3->T4->Prop ] : Set := - exist_4 : (x1:T1)(x2:T2)(x3:T3)(x4:T4) - (P x1 x2 x3 x4) - -> (sig_4 T1 T2 T3 T4 P). +Record tuple_7 (T1 T2 T3 T4 T5 T6 T7:Set) : Set := + {proj_7_1 : T1; + proj_7_2 : T2; + proj_7_3 : T3; + proj_7_4 : T4; + proj_7_5 : T5; + proj_7_6 : T6; + proj_7_7 : T7}. -Inductive sig_5 [ T1,T2,T3,T4,T5 : Set; - P:T1->T2->T3->T4->T5->Prop ] : Set := - exist_5 : (x1:T1)(x2:T2)(x3:T3)(x4:T4)(x5:T5) - (P x1 x2 x3 x4 x5) - -> (sig_5 T1 T2 T3 T4 T5 P). -Inductive sig_6 [ T1,T2,T3,T4,T5,T6 : Set; - P:T1->T2->T3->T4->T5->T6->Prop ] : Set := - exist_6 : (x1:T1)(x2:T2)(x3:T3)(x4:T4)(x5:T5)(x6:T6) - (P x1 x2 x3 x4 x5 x6) - -> (sig_6 T1 T2 T3 T4 T5 T6 P). - -Inductive sig_7 [ T1,T2,T3,T4,T5,T6,T7 : Set; - P:T1->T2->T3->T4->T5->T6->T7->Prop ] : Set := - exist_7 : (x1:T1)(x2:T2)(x3:T3)(x4:T4)(x5:T5)(x6:T6)(x7:T7) - (P x1 x2 x3 x4 x5 x6 x7) - -> (sig_7 T1 T2 T3 T4 T5 T6 T7 P). - -Inductive sig_8 [ T1,T2,T3,T4,T5,T6,T7,T8 : Set; - P:T1->T2->T3->T4->T5->T6->T7->T8->Prop ] : Set := - exist_8 : (x1:T1)(x2:T2)(x3:T3)(x4:T4)(x5:T5)(x6:T6)(x7:T7)(x8:T8) - (P x1 x2 x3 x4 x5 x6 x7 x8) - -> (sig_8 T1 T2 T3 T4 T5 T6 T7 T8 P). - -Inductive dep_tuple_2 [ T1,T2 : Set; P:T1->T2->Set ] : Set := - Build_dep_tuple_2 : (x1:T1)(x2:T2)(P x1 x2) -> (dep_tuple_2 T1 T2 P). +(* Existentials *) -Inductive dep_tuple_3 [ T1,T2,T3 : Set; P:T1->T2->T3->Set ] : Set := - Build_dep_tuple_3 : (x1:T1)(x2:T2)(x3:T3)(P x1 x2 x3) - -> (dep_tuple_3 T1 T2 T3 P). +Definition sig_1 := sig. +Definition exist_1 := exist. +Inductive sig_2 (T1 T2:Set) (P:T1 -> T2 -> Prop) : Set := + exist_2 : forall (x1:T1) (x2:T2), P x1 x2 -> sig_2 T1 T2 P. + +Inductive sig_3 (T1 T2 T3:Set) (P:T1 -> T2 -> T3 -> Prop) : Set := + exist_3 : forall (x1:T1) (x2:T2) (x3:T3), P x1 x2 x3 -> sig_3 T1 T2 T3 P. + + +Inductive sig_4 (T1 T2 T3 T4:Set) (P:T1 -> T2 -> T3 -> T4 -> Prop) : Set := + exist_4 : + forall (x1:T1) (x2:T2) (x3:T3) (x4:T4), + P x1 x2 x3 x4 -> sig_4 T1 T2 T3 T4 P. + +Inductive sig_5 (T1 T2 T3 T4 T5:Set) (P:T1 -> T2 -> T3 -> T4 -> T5 -> Prop) : +Set := + exist_5 : + forall (x1:T1) (x2:T2) (x3:T3) (x4:T4) (x5:T5), + P x1 x2 x3 x4 x5 -> sig_5 T1 T2 T3 T4 T5 P. + +Inductive sig_6 (T1 T2 T3 T4 T5 T6:Set) +(P:T1 -> T2 -> T3 -> T4 -> T5 -> T6 -> Prop) : Set := + exist_6 : + forall (x1:T1) (x2:T2) (x3:T3) (x4:T4) (x5:T5) + (x6:T6), P x1 x2 x3 x4 x5 x6 -> sig_6 T1 T2 T3 T4 T5 T6 P. + +Inductive sig_7 (T1 T2 T3 T4 T5 T6 T7:Set) +(P:T1 -> T2 -> T3 -> T4 -> T5 -> T6 -> T7 -> Prop) : Set := + exist_7 : + forall (x1:T1) (x2:T2) (x3:T3) (x4:T4) (x5:T5) + (x6:T6) (x7:T7), + P x1 x2 x3 x4 x5 x6 x7 -> sig_7 T1 T2 T3 T4 T5 T6 T7 P. + +Inductive sig_8 (T1 T2 T3 T4 T5 T6 T7 T8:Set) +(P:T1 -> T2 -> T3 -> T4 -> T5 -> T6 -> T7 -> T8 -> Prop) : Set := + exist_8 : + forall (x1:T1) (x2:T2) (x3:T3) (x4:T4) (x5:T5) + (x6:T6) (x7:T7) (x8:T8), + P x1 x2 x3 x4 x5 x6 x7 x8 -> sig_8 T1 T2 T3 T4 T5 T6 T7 T8 P. + +Inductive dep_tuple_2 (T1 T2:Set) (P:T1 -> T2 -> Set) : Set := + Build_dep_tuple_2 : + forall (x1:T1) (x2:T2), P x1 x2 -> dep_tuple_2 T1 T2 P. + +Inductive dep_tuple_3 (T1 T2 T3:Set) (P:T1 -> T2 -> T3 -> Set) : Set := + Build_dep_tuple_3 : + forall (x1:T1) (x2:T2) (x3:T3), P x1 x2 x3 -> dep_tuple_3 T1 T2 T3 P. diff --git a/contrib/field/Field.v b/contrib/field/Field.v index df2a44f3e..a7cf332a7 100644 --- a/contrib/field/Field.v +++ b/contrib/field/Field.v @@ -12,4 +12,4 @@ Require Export Field_Compl. Require Export Field_Theory. Require Export Field_Tactic. -(* Command declarations are moved to the ML side *) +(* Command declarations are moved to the ML side *)
\ No newline at end of file diff --git a/contrib/field/Field_Compl.v b/contrib/field/Field_Compl.v index aa3a99147..c90fea1ec 100644 --- a/contrib/field/Field_Compl.v +++ b/contrib/field/Field_Compl.v @@ -8,55 +8,54 @@ (* $Id$ *) -Inductive listT [A:Type] : Type := - nilT : (listT A) | consT : A->(listT A)->(listT A). - -Fixpoint appT [A:Type][l:(listT A)] : (listT A) -> (listT A) := - [m:(listT A)] - Cases l of - | nilT => m - | (consT a l1) => (consT A a (appT A l1 m)) +Inductive listT (A:Type) : Type := + | nilT : listT A + | consT : A -> listT A -> listT A. + +Fixpoint appT (A:Type) (l m:listT A) {struct l} : listT A := + match l with + | nilT => m + | consT a l1 => consT A a (appT A l1 m) end. -Inductive prodT [A,B:Type] : Type := - pairT: A->B->(prodT A B). +Inductive prodT (A B:Type) : Type := + pairT : A -> B -> prodT A B. Definition assoc_2nd := -Fix assoc_2nd_rec - {assoc_2nd_rec - [A:Type;B:Set;eq_dec:(e1,e2:B){e1=e2}+{~e1=e2};lst:(listT (prodT A B))] - : B->A->A:= - [key:B;default:A] - Cases lst of - | nilT => default - | (consT (pairT v e) l) => - (Cases (eq_dec e key) of - | (left _) => v - | (right _) => (assoc_2nd_rec A B eq_dec l key default) - end) - end}. - -Definition fstT [A,B:Type;c:(prodT A B)] := - Cases c of - | (pairT a _) => a - end. - -Definition sndT [A,B:Type;c:(prodT A B)] := - Cases c of - | (pairT _ a) => a - end. + (fix assoc_2nd_rec (A:Type) (B:Set) + (eq_dec:forall e1 e2:B, {e1 = e2} + {e1 <> e2}) + (lst:listT (prodT A B)) {struct lst} : + B -> A -> A := + fun (key:B) (default:A) => + match lst with + | nilT => default + | consT (pairT v e) l => + match eq_dec e key with + | left _ => v + | right _ => assoc_2nd_rec A B eq_dec l key default + end + end). + +Definition fstT (A B:Type) (c:prodT A B) := match c with + | pairT a _ => a + end. + +Definition sndT (A B:Type) (c:prodT A B) := match c with + | pairT _ a => a + end. Definition mem := -Fix mem {mem [A:Set;eq_dec:(e1,e2:A){e1=e2}+{~e1=e2};a:A;l:(listT A)] : bool := - Cases l of - | nilT => false - | (consT a1 l1) => - Cases (eq_dec a a1) of - | (left _) => true - | (right _) => (mem A eq_dec a l1) - end - end}. - -Inductive option [A:Type] : Type := - | None : (option A) - | Some : (A -> A -> A) -> (option A). + (fix mem (A:Set) (eq_dec:forall e1 e2:A, {e1 = e2} + {e1 <> e2}) + (a:A) (l:listT A) {struct l} : bool := + match l with + | nilT => false + | consT a1 l1 => + match eq_dec a a1 with + | left _ => true + | right _ => mem A eq_dec a l1 + end + end). + +Inductive option (A:Type) : Type := + | None : option A + | Some : (A -> A -> A) -> option A.
\ No newline at end of file diff --git a/contrib/field/Field_Tactic.v b/contrib/field/Field_Tactic.v index cd382bc39..a5b206fb2 100644 --- a/contrib/field/Field_Tactic.v +++ b/contrib/field/Field_Tactic.v @@ -8,102 +8,101 @@ (* $Id$ *) -Require Ring. +Require Import Ring. Require Export Field_Compl. Require Export Field_Theory. (**** Interpretation A --> ExprA ****) -Recursive Tactic Definition MemAssoc var lvar := - Match lvar With - | [(nilT ?)] -> false - | [(consT ? ?1 ?2)] -> - (Match ?1=var With - | [?1=?1] -> true - | _ -> (MemAssoc var ?2)). - -Recursive Tactic Definition SeekVarAux FT lvar trm := - Let AT = Eval Cbv Beta Delta [A] Iota in (A FT) - And AzeroT = Eval Cbv Beta Delta [Azero] Iota in (Azero FT) - And AoneT = Eval Cbv Beta Delta [Aone] Iota in (Aone FT) - And AplusT = Eval Cbv Beta Delta [Aplus] Iota in (Aplus FT) - And AmultT = Eval Cbv Beta Delta [Amult] Iota in (Amult FT) - And AoppT = Eval Cbv Beta Delta [Aopp] Iota in (Aopp FT) - And AinvT = Eval Cbv Beta Delta [Ainv] Iota in (Ainv FT) In - Match trm With - | [(AzeroT)] -> lvar - | [(AoneT)] -> lvar - | [(AplusT ?1 ?2)] -> - Let l1 = (SeekVarAux FT lvar ?1) In - (SeekVarAux FT l1 ?2) - | [(AmultT ?1 ?2)] -> - Let l1 = (SeekVarAux FT lvar ?1) In - (SeekVarAux FT l1 ?2) - | [(AoppT ?1)] -> (SeekVarAux FT lvar ?1) - | [(AinvT ?1)] -> (SeekVarAux FT lvar ?1) - | [?1] -> - Let res = (MemAssoc ?1 lvar) In - Match res With - | [(true)] -> lvar - | [(false)] -> '(consT AT ?1 lvar). - -Tactic Definition SeekVar FT trm := - Let AT = Eval Cbv Beta Delta [A] Iota in (A FT) In - (SeekVarAux FT '(nilT AT) trm). - -Recursive Tactic Definition NumberAux lvar cpt := - Match lvar With - | [(nilT ?1)] -> '(nilT (prodT ?1 nat)) - | [(consT ?1 ?2 ?3)] -> - Let l2 = (NumberAux ?3 '(S cpt)) In - '(consT (prodT ?1 nat) (pairT ?1 nat ?2 cpt) l2). - -Tactic Definition Number lvar := (NumberAux lvar O). - -Tactic Definition BuildVarList FT trm := - Let lvar = (SeekVar FT trm) In - (Number lvar). -V7only [ -(*Used by contrib Maple *) -Tactic Definition build_var_list := BuildVarList. -]. - -Recursive Tactic Definition Assoc elt lst := - Match lst With - | [(nilT ?)] -> Fail - | [(consT (prodT ? nat) (pairT ? nat ?1 ?2) ?3)] -> - Match elt= ?1 With - | [?1= ?1] -> ?2 - | _ -> (Assoc elt ?3). - -Recursive Meta Definition interp_A FT lvar trm := - Let AT = Eval Cbv Beta Delta [A] Iota in (A FT) - And AzeroT = Eval Cbv Beta Delta [Azero] Iota in (Azero FT) - And AoneT = Eval Cbv Beta Delta [Aone] Iota in (Aone FT) - And AplusT = Eval Cbv Beta Delta [Aplus] Iota in (Aplus FT) - And AmultT = Eval Cbv Beta Delta [Amult] Iota in (Amult FT) - And AoppT = Eval Cbv Beta Delta [Aopp] Iota in (Aopp FT) - And AinvT = Eval Cbv Beta Delta [Ainv] Iota in (Ainv FT) In - Match trm With - | [(AzeroT)] -> EAzero - | [(AoneT)] -> EAone - | [(AplusT ?1 ?2)] -> - Let e1 = (interp_A FT lvar ?1) - And e2 = (interp_A FT lvar ?2) In - '(EAplus e1 e2) - | [(AmultT ?1 ?2)] -> - Let e1 = (interp_A FT lvar ?1) - And e2 = (interp_A FT lvar ?2) In - '(EAmult e1 e2) - | [(AoppT ?1)] -> - Let e = (interp_A FT lvar ?1) In - '(EAopp e) - | [(AinvT ?1)] -> - Let e = (interp_A FT lvar ?1) In - '(EAinv e) - | [?1] -> - Let idx = (Assoc ?1 lvar) In - '(EAvar idx). +Ltac mem_assoc var lvar := + match constr:lvar with + | (nilT _) => constr:false + | (consT _ ?X1 ?X2) => + match constr:(X1 = var) with + | (?X1 = ?X1) => constr:true + | _ => mem_assoc var X2 + end + end. + +Ltac seek_var_aux FT lvar trm := + let AT := eval cbv beta iota delta [A] in (A FT) + with AzeroT := eval cbv beta iota delta [Azero] in (Azero FT) + with AoneT := eval cbv beta iota delta [Aone] in (Aone FT) + with AplusT := eval cbv beta iota delta [Aplus] in (Aplus FT) + with AmultT := eval cbv beta iota delta [Amult] in (Amult FT) + with AoppT := eval cbv beta iota delta [Aopp] in (Aopp FT) + with AinvT := eval cbv beta iota delta [Ainv] in (Ainv FT) in + match constr:trm with + | AzeroT => lvar + | AoneT => lvar + | (AplusT ?X1 ?X2) => + let l1 := seek_var_aux FT lvar X1 in + seek_var_aux FT l1 X2 + | (AmultT ?X1 ?X2) => + let l1 := seek_var_aux FT lvar X1 in + seek_var_aux FT l1 X2 + | (AoppT ?X1) => seek_var_aux FT lvar X1 + | (AinvT ?X1) => seek_var_aux FT lvar X1 + | ?X1 => + let res := mem_assoc X1 lvar in + match constr:res with + | true => lvar + | false => constr:(consT AT X1 lvar) + end + end. + +Ltac seek_var FT trm := + let AT := eval cbv beta iota delta [A] in (A FT) in + seek_var_aux FT (nilT AT) trm. + +Ltac number_aux lvar cpt := + match constr:lvar with + | (nilT ?X1) => constr:(nilT (prodT X1 nat)) + | (consT ?X1 ?X2 ?X3) => + let l2 := number_aux X3 (S cpt) in + constr:(consT (prodT X1 nat) (pairT X1 nat X2 cpt) l2) + end. + +Ltac number lvar := number_aux lvar 0. + +Ltac build_varlist FT trm := let lvar := seek_var FT trm in + number lvar. + +Ltac assoc elt lst := + match constr:lst with + | (nilT _) => fail + | (consT (prodT _ nat) (pairT _ nat ?X1 ?X2) ?X3) => + match constr:(elt = X1) with + | (?X1 = ?X1) => constr:X2 + | _ => assoc elt X3 + end + end. + +Ltac interp_A FT lvar trm := + let AT := eval cbv beta iota delta [A] in (A FT) + with AzeroT := eval cbv beta iota delta [Azero] in (Azero FT) + with AoneT := eval cbv beta iota delta [Aone] in (Aone FT) + with AplusT := eval cbv beta iota delta [Aplus] in (Aplus FT) + with AmultT := eval cbv beta iota delta [Amult] in (Amult FT) + with AoppT := eval cbv beta iota delta [Aopp] in (Aopp FT) + with AinvT := eval cbv beta iota delta [Ainv] in (Ainv FT) in + match constr:trm with + | AzeroT => constr:EAzero + | AoneT => constr:EAone + | (AplusT ?X1 ?X2) => + let e1 := interp_A FT lvar X1 with e2 := interp_A FT lvar X2 in + constr:(EAplus e1 e2) + | (AmultT ?X1 ?X2) => + let e1 := interp_A FT lvar X1 with e2 := interp_A FT lvar X2 in + constr:(EAmult e1 e2) + | (AoppT ?X1) => + let e := interp_A FT lvar X1 in + constr:(EAopp e) + | (AinvT ?X1) => let e := interp_A FT lvar X1 in + constr:(EAinv e) + | ?X1 => let idx := assoc X1 lvar in + constr:(EAvar idx) + end. (************************) (* Simplification *) @@ -111,166 +110,190 @@ Recursive Meta Definition interp_A FT lvar trm := (**** Generation of the multiplier ****) -Recursive Tactic Definition Remove e l := - Match l With - | [(nilT ?)] -> l - | [(consT ?1 e ?2)] -> ?2 - | [(consT ?1 ?2 ?3)] -> - Let nl = (Remove e ?3) In - '(consT ?1 ?2 nl). - -Recursive Tactic Definition Union l1 l2 := - Match l1 With - | [(nilT ?)] -> l2 - | [(consT ?1 ?2 ?3)] -> - Let nl2 = (Remove ?2 l2) In - Let nl = (Union ?3 nl2) In - '(consT ?1 ?2 nl). - -Recursive Tactic Definition RawGiveMult trm := - Match trm With - | [(EAinv ?1)] -> '(consT ExprA ?1 (nilT ExprA)) - | [(EAopp ?1)] -> (RawGiveMult ?1) - | [(EAplus ?1 ?2)] -> - Let l1 = (RawGiveMult ?1) - And l2 = (RawGiveMult ?2) In - (Union l1 l2) - | [(EAmult ?1 ?2)] -> - Let l1 = (RawGiveMult ?1) - And l2 = (RawGiveMult ?2) In - Eval Compute in (appT ExprA l1 l2) - | _ -> '(nilT ExprA). - -Tactic Definition GiveMult trm := - Let ltrm = (RawGiveMult trm) In - '(mult_of_list ltrm). +Ltac remove e l := + match constr:l with + | (nilT _) => l + | (consT ?X1 e ?X2) => constr:X2 + | (consT ?X1 ?X2 ?X3) => let nl := remove e X3 in + constr:(consT X1 X2 nl) + end. + +Ltac union l1 l2 := + match constr:l1 with + | (nilT _) => l2 + | (consT ?X1 ?X2 ?X3) => + let nl2 := remove X2 l2 in + let nl := union X3 nl2 in + constr:(consT X1 X2 nl) + end. + +Ltac raw_give_mult trm := + match constr:trm with + | (EAinv ?X1) => constr:(consT ExprA X1 (nilT ExprA)) + | (EAopp ?X1) => raw_give_mult X1 + | (EAplus ?X1 ?X2) => + let l1 := raw_give_mult X1 with l2 := raw_give_mult X2 in + union l1 l2 + | (EAmult ?X1 ?X2) => + let l1 := raw_give_mult X1 with l2 := raw_give_mult X2 in + eval compute in (appT ExprA l1 l2) + | _ => constr:(nilT ExprA) + end. + +Ltac give_mult trm := + let ltrm := raw_give_mult trm in + constr:(mult_of_list ltrm). (**** Associativity ****) -Tactic Definition ApplyAssoc FT lvar trm := - Let t=Eval Compute in (assoc trm) In - Match t=trm With - | [ ?1=?1 ] -> Idtac - | _ -> Rewrite <- (assoc_correct FT trm); Change (assoc trm) with t. +Ltac apply_assoc FT lvar trm := + let t := eval compute in (assoc trm) in + match constr:(t = trm) with + | (?X1 = ?X1) => idtac + | _ => + rewrite <- (assoc_correct FT trm); change (assoc trm) with t in |- * + end. (**** Distribution *****) -Tactic Definition ApplyDistrib FT lvar trm := - Let t=Eval Compute in (distrib trm) In - Match t=trm With - | [ ?1=?1 ] -> Idtac - | _ -> Rewrite <- (distrib_correct FT trm); Change (distrib trm) with t. +Ltac apply_distrib FT lvar trm := + let t := eval compute in (distrib trm) in + match constr:(t = trm) with + | (?X1 = ?X1) => idtac + | _ => + rewrite <- (distrib_correct FT trm); + change (distrib trm) with t in |- * + end. (**** Multiplication by the inverse product ****) -Tactic Definition GrepMult := - Match Context With - | [ id: ~(interp_ExprA ? ? ?)= ? |- ?] -> id. - -Tactic Definition WeakReduce := - Match Context With - | [|-[(interp_ExprA ?1 ?2 ?)]] -> - Cbv Beta Delta [interp_ExprA assoc_2nd eq_nat_dec mult_of_list ?1 ?2 A - Azero Aone Aplus Amult Aopp Ainv] Zeta Iota. - -Tactic Definition Multiply mul := - Match Context With - | [|-(interp_ExprA ?1 ?2 ?3)=(interp_ExprA ?1 ?2 ?4)] -> - Let AzeroT = Eval Cbv Beta Delta [Azero ?1] Iota in (Azero ?1) In - Cut ~(interp_ExprA ?1 ?2 mul)=AzeroT; - [Intro; - Let id = GrepMult In - Apply (mult_eq ?1 ?3 ?4 mul ?2 id) - |WeakReduce; - Let AoneT = Eval Cbv Beta Delta [Aone ?1] Iota in (Aone ?1) - And AmultT = Eval Cbv Beta Delta [Amult ?1] Iota in (Amult ?1) In - Try (Match Context With - | [|-[(AmultT ? AoneT)]] -> Rewrite (AmultT_1r ?1));Clear ?1 ?2]. - -Tactic Definition ApplyMultiply FT lvar trm := - Let t=Eval Compute in (multiply trm) In - Match t=trm With - | [ ?1=?1 ] -> Idtac - | _ -> Rewrite <- (multiply_correct FT trm); Change (multiply trm) with t. +Ltac grep_mult := match goal with + | id:(interp_ExprA _ _ _ <> _) |- _ => id + end. + +Ltac weak_reduce := + match goal with + | |- context [(interp_ExprA ?X1 ?X2 _)] => + cbv beta iota zeta + delta [interp_ExprA assoc_2nd eq_nat_dec mult_of_list X1 X2 A Azero + Aone Aplus Amult Aopp Ainv] in |- * + end. + +Ltac multiply mul := + match goal with + | |- (interp_ExprA ?X1 ?X2 ?X3 = interp_ExprA ?X1 ?X2 ?X4) => + let AzeroT := eval cbv beta iota delta [Azero X1] in (Azero X1) in + (cut (interp_ExprA X1 X2 mul <> AzeroT); + [ intro; let id := grep_mult in + apply (mult_eq X1 X3 X4 mul X2 id) + | weak_reduce; + let AoneT := eval cbv beta iota delta [Aone X1] in (Aone X1) + with AmultT := eval cbv beta iota delta [Amult X1] in (Amult X1) in + (try + match goal with + | |- context [(AmultT _ AoneT)] => rewrite (AmultT_1r X1) + end; clear X1 X2) ]) + end. + +Ltac apply_multiply FT lvar trm := + let t := eval compute in (multiply trm) in + match constr:(t = trm) with + | (?X1 = ?X1) => idtac + | _ => + rewrite <- (multiply_correct FT trm); + change (multiply trm) with t in |- * + end. (**** Permutations and simplification ****) -Tactic Definition ApplyInverse mul FT lvar trm := - Let t=Eval Compute in (inverse_simplif mul trm) In - Match t=trm With - | [ ?1=?1 ] -> Idtac - | _ -> Rewrite <- (inverse_correct FT trm mul); - [Change (inverse_simplif mul trm) with t|Assumption]. +Ltac apply_inverse mul FT lvar trm := + let t := eval compute in (inverse_simplif mul trm) in + match constr:(t = trm) with + | (?X1 = ?X1) => idtac + | _ => + rewrite <- (inverse_correct FT trm mul); + [ change (inverse_simplif mul trm) with t in |- * | assumption ] + end. (**** Inverse test ****) -Tactic Definition StrongFail tac := First [tac|Fail 2]. - -Recursive Tactic Definition InverseTestAux FT trm := - Let AplusT = Eval Cbv Beta Delta [Aplus] Iota in (Aplus FT) - And AmultT = Eval Cbv Beta Delta [Amult] Iota in (Amult FT) - And AoppT = Eval Cbv Beta Delta [Aopp] Iota in (Aopp FT) - And AinvT = Eval Cbv Beta Delta [Ainv] Iota in (Ainv FT) In - Match trm With - | [(AinvT ?)] -> Fail 1 - | [(AoppT ?1)] -> StrongFail ((InverseTestAux FT ?1);Idtac) - | [(AplusT ?1 ?2)] -> - StrongFail ((InverseTestAux FT ?1);(InverseTestAux FT ?2)) - | [(AmultT ?1 ?2)] -> - StrongFail ((InverseTestAux FT ?1);(InverseTestAux FT ?2)) - | _ -> Idtac. - -Tactic Definition InverseTest FT := - Let AplusT = Eval Cbv Beta Delta [Aplus] Iota in (Aplus FT) In - Match Context With - | [|- ?1=?2] -> (InverseTestAux FT '(AplusT ?1 ?2)). +Ltac strong_fail tac := first [ tac | fail 2 ]. + +Ltac inverse_test_aux FT trm := + let AplusT := eval cbv beta iota delta [Aplus] in (Aplus FT) + with AmultT := eval cbv beta iota delta [Amult] in (Amult FT) + with AoppT := eval cbv beta iota delta [Aopp] in (Aopp FT) + with AinvT := eval cbv beta iota delta [Ainv] in (Ainv FT) in + match constr:trm with + | (AinvT _) => fail 1 + | (AoppT ?X1) => + strong_fail ltac:(inverse_test_aux FT X1; idtac) + | (AplusT ?X1 ?X2) => + strong_fail ltac:(inverse_test_aux FT X1; inverse_test_aux FT X2) + | (AmultT ?X1 ?X2) => + strong_fail ltac:(inverse_test_aux FT X1; inverse_test_aux FT X2) + | _ => idtac + end. + +Ltac inverse_test FT := + let AplusT := eval cbv beta iota delta [Aplus] in (Aplus FT) in + match goal with + | |- (?X1 = ?X2) => inverse_test_aux FT (AplusT X1 X2) + end. (**** Field itself ****) -Tactic Definition ApplySimplif sfun := - (Match Context With - | [|- (interp_ExprA ?1 ?2 ?3)=(interp_ExprA ? ? ?)] -> - (sfun ?1 ?2 ?3)); - (Match Context With - | [|- (interp_ExprA ? ? ?)=(interp_ExprA ?1 ?2 ?3)] -> - (sfun ?1 ?2 ?3)). - -Tactic Definition Unfolds FT := - (Match Eval Cbv Beta Delta [Aminus] Iota in (Aminus FT) With - | [(Some ? ?1)] -> Unfold ?1 - | _ -> Idtac); - (Match Eval Cbv Beta Delta [Adiv] Iota in (Adiv FT) With - | [(Some ? ?1)] -> Unfold ?1 - | _ -> Idtac). - -Tactic Definition Reduce FT := - Let AzeroT = Eval Cbv Beta Delta [Azero] Iota in (Azero FT) - And AoneT = Eval Cbv Beta Delta [Aone] Iota in (Aone FT) - And AplusT = Eval Cbv Beta Delta [Aplus] Iota in (Aplus FT) - And AmultT = Eval Cbv Beta Delta [Amult] Iota in (Amult FT) - And AoppT = Eval Cbv Beta Delta [Aopp] Iota in (Aopp FT) - And AinvT = Eval Cbv Beta Delta [Ainv] Iota in (Ainv FT) In - Cbv Beta Delta -[AzeroT AoneT AplusT AmultT AoppT AinvT] Zeta Iota - Orelse Compute. - -Recursive Tactic Definition Field_Gen_Aux FT := - Let AplusT = Eval Cbv Beta Delta [Aplus] Iota in (Aplus FT) In - Match Context With - | [|- ?1=?2] -> - Let lvar = (BuildVarList FT '(AplusT ?1 ?2)) In - Let trm1 = (interp_A FT lvar ?1) - And trm2 = (interp_A FT lvar ?2) In - Let mul = (GiveMult '(EAplus trm1 trm2)) In - Cut [ft:=FT][vm:=lvar](interp_ExprA ft vm trm1)=(interp_ExprA ft vm trm2); - [Compute;Auto - |Intros ft vm;(ApplySimplif ApplyDistrib);(ApplySimplif ApplyAssoc); - (Multiply mul);[(ApplySimplif ApplyMultiply); - (ApplySimplif (ApplyInverse mul)); - (Let id = GrepMult In Clear id);WeakReduce;Clear ft vm; - First [(InverseTest FT);Ring|(Field_Gen_Aux FT)]|Idtac]]. - -Tactic Definition Field_Gen FT := - Unfolds FT;((InverseTest FT);Ring) Orelse (Field_Gen_Aux FT). -V7only [Tactic Definition field_gen := Field_Gen.]. +Ltac apply_simplif sfun := + match goal with + | |- (interp_ExprA ?X1 ?X2 ?X3 = interp_ExprA _ _ _) => + sfun X1 X2 X3 + end; + match goal with + | |- (interp_ExprA _ _ _ = interp_ExprA ?X1 ?X2 ?X3) => + sfun X1 X2 X3 + end. + +Ltac unfolds FT := + match eval cbv beta iota delta [Aminus] in (Aminus FT) with + | (Some _ ?X1) => unfold X1 in |- * + | _ => idtac + end; + match eval cbv beta iota delta [Adiv] in (Adiv FT) with + | (Some _ ?X1) => unfold X1 in |- * + | _ => idtac + end. + +Ltac reduce FT := + let AzeroT := eval cbv beta iota delta [Azero] in (Azero FT) + with AoneT := eval cbv beta iota delta [Aone] in (Aone FT) + with AplusT := eval cbv beta iota delta [Aplus] in (Aplus FT) + with AmultT := eval cbv beta iota delta [Amult] in (Amult FT) + with AoppT := eval cbv beta iota delta [Aopp] in (Aopp FT) + with AinvT := eval cbv beta iota delta [Ainv] in (Ainv FT) in + (cbv beta iota zeta delta -[AzeroT AoneT AplusT AmultT AoppT AinvT] in |- * || + compute in |- *). + +Ltac field_gen_aux FT := + let AplusT := eval cbv beta iota delta [Aplus] in (Aplus FT) in + match goal with + | |- (?X1 = ?X2) => + let lvar := build_varlist FT (AplusT X1 X2) in + let trm1 := interp_A FT lvar X1 with trm2 := interp_A FT lvar X2 in + let mul := give_mult (EAplus trm1 trm2) in + (cut + (let ft := FT in + let vm := lvar in interp_ExprA ft vm trm1 = interp_ExprA ft vm trm2); + [ compute in |- *; auto + | intros ft vm; apply_simplif apply_distrib; + apply_simplif apply_assoc; multiply mul; + [ apply_simplif apply_multiply; + apply_simplif ltac:(apply_inverse mul); + let id := grep_mult in + clear id; weak_reduce; clear ft vm; first + [ inverse_test FT; ring | field_gen_aux FT ] + | idtac ] ]) + end. + +Ltac field_gen FT := unfolds FT; (inverse_test FT; ring) || field_gen_aux FT. (*****************************) (* Term Simplification *) @@ -278,120 +301,132 @@ V7only [Tactic Definition field_gen := Field_Gen.]. (**** Minus and division expansions ****) -Meta Definition InitExp FT trm := - Let e = - (Match Eval Cbv Beta Delta [Aminus] Iota in (Aminus FT) With - | [(Some ? ?1)] -> Eval Cbv Beta Delta [?1] in trm - | _ -> trm) In - Match Eval Cbv Beta Delta [Adiv] Iota in (Adiv FT) With - | [(Some ? ?1)] -> Eval Cbv Beta Delta [?1] in e - | _ -> e. -V7only [ -(*Used by contrib Maple *) -Tactic Definition init_exp := InitExp. -]. +Ltac init_exp FT trm := + let e := + (match eval cbv beta iota delta [Aminus] in (Aminus FT) with + | (Some _ ?X1) => eval cbv beta delta [X1] in trm + | _ => trm + end) in + match eval cbv beta iota delta [Adiv] in (Adiv FT) with + | (Some _ ?X1) => eval cbv beta delta [X1] in e + | _ => e + end. (**** Inverses simplification ****) -Recursive Meta Definition SimplInv trm:= - Match trm With - | [(EAplus ?1 ?2)] -> - Let e1 = (SimplInv ?1) - And e2 = (SimplInv ?2) In - '(EAplus e1 e2) - | [(EAmult ?1 ?2)] -> - Let e1 = (SimplInv ?1) - And e2 = (SimplInv ?2) In - '(EAmult e1 e2) - | [(EAopp ?1)] -> Let e = (SimplInv ?1) In '(EAopp e) - | [(EAinv ?1)] -> (SimplInvAux ?1) - | [?1] -> ?1 -And SimplInvAux trm := - Match trm With - | [(EAinv ?1)] -> (SimplInv ?1) - | [(EAmult ?1 ?2)] -> - Let e1 = (SimplInv '(EAinv ?1)) - And e2 = (SimplInv '(EAinv ?2)) In - '(EAmult e1 e2) - | [?1] -> Let e = (SimplInv ?1) In '(EAinv e). +Ltac simpl_inv trm := + match constr:trm with + | (EAplus ?X1 ?X2) => + let e1 := simpl_inv X1 with e2 := simpl_inv X2 in + constr:(EAplus e1 e2) + | (EAmult ?X1 ?X2) => + let e1 := simpl_inv X1 with e2 := simpl_inv X2 in + constr:(EAmult e1 e2) + | (EAopp ?X1) => let e := simpl_inv X1 in + constr:(EAopp e) + | (EAinv ?X1) => SimplInvAux X1 + | ?X1 => constr:X1 + end + with SimplInvAux trm := + match constr:trm with + | (EAinv ?X1) => simpl_inv X1 + | (EAmult ?X1 ?X2) => + let e1 := simpl_inv (EAinv X1) with e2 := simpl_inv (EAinv X2) in + constr:(EAmult e1 e2) + | ?X1 => let e := simpl_inv X1 in + constr:(EAinv e) + end. (**** Monom simplification ****) -Recursive Meta Definition Map fcn lst := - Match lst With - | [(nilT ?)] -> lst - | [(consT ?1 ?2 ?3)] -> - Let r = (fcn ?2) - And t = (Map fcn ?3) In - '(consT ?1 r t). - -Recursive Meta Definition BuildMonomAux lst trm := - Match lst With - | [(nilT ?)] -> Eval Compute in (assoc trm) - | [(consT ? ?1 ?2)] -> BuildMonomAux ?2 '(EAmult trm ?1). - -Recursive Meta Definition BuildMonom lnum lden := - Let ildn = (Map (Fun e -> '(EAinv e)) lden) In - Let ltot = Eval Compute in (appT ExprA lnum ildn) In - Let trm = (BuildMonomAux ltot EAone) In - Match trm With - | [(EAmult ? ?1)] -> ?1 - | [?1] -> ?1. - -Recursive Meta Definition SimplMonomAux lnum lden trm := - Match trm With - | [(EAmult (EAinv ?1) ?2)] -> - Let mma = (MemAssoc ?1 lnum) In - (Match mma With - | [true] -> - Let newlnum = (Remove ?1 lnum) In SimplMonomAux newlnum lden ?2 - | [false] -> SimplMonomAux lnum '(consT ExprA ?1 lden) ?2) - | [(EAmult ?1 ?2)] -> - Let mma = (MemAssoc ?1 lden) In - (Match mma With - | [true] -> - Let newlden = (Remove ?1 lden) In SimplMonomAux lnum newlden ?2 - | [false] -> SimplMonomAux '(consT ExprA ?1 lnum) lden ?2) - | [(EAinv ?1)] -> - Let mma = (MemAssoc ?1 lnum) In - (Match mma With - | [true] -> - Let newlnum = (Remove ?1 lnum) In BuildMonom newlnum lden - | [false] -> BuildMonom lnum '(consT ExprA ?1 lden)) - | [?1] -> - Let mma = (MemAssoc ?1 lden) In - (Match mma With - | [true] -> - Let newlden = (Remove ?1 lden) In BuildMonom lnum newlden - | [false] -> BuildMonom '(consT ExprA ?1 lnum) lden). - -Meta Definition SimplMonom trm := - SimplMonomAux '(nilT ExprA) '(nilT ExprA) trm. - -Recursive Meta Definition SimplAllMonoms trm := - Match trm With - | [(EAplus ?1 ?2)] -> - Let e1 = (SimplMonom ?1) - And e2 = (SimplAllMonoms ?2) In - '(EAplus e1 e2) - | [?1] -> SimplMonom ?1. +Ltac map_tactic fcn lst := + match constr:lst with + | (nilT _) => lst + | (consT ?X1 ?X2 ?X3) => + let r := fcn X2 with t := map_tactic fcn X3 in + constr:(consT X1 r t) + end. + +Ltac build_monom_aux lst trm := + match constr:lst with + | (nilT _) => eval compute in (assoc trm) + | (consT _ ?X1 ?X2) => build_monom_aux X2 (EAmult trm X1) + end. + +Ltac build_monom lnum lden := + let ildn := map_tactic ltac:(fun e => constr:(EAinv e)) lden in + let ltot := eval compute in (appT ExprA lnum ildn) in + let trm := build_monom_aux ltot EAone in + match constr:trm with + | (EAmult _ ?X1) => constr:X1 + | ?X1 => constr:X1 + end. + +Ltac simpl_monom_aux lnum lden trm := + match constr:trm with + | (EAmult (EAinv ?X1) ?X2) => + let mma := mem_assoc X1 lnum in + match constr:mma with + | true => + let newlnum := remove X1 lnum in + simpl_monom_aux newlnum lden X2 + | false => simpl_monom_aux lnum (consT ExprA X1 lden) X2 + end + | (EAmult ?X1 ?X2) => + let mma := mem_assoc X1 lden in + match constr:mma with + | true => + let newlden := remove X1 lden in + simpl_monom_aux lnum newlden X2 + | false => simpl_monom_aux (consT ExprA X1 lnum) lden X2 + end + | (EAinv ?X1) => + let mma := mem_assoc X1 lnum in + match constr:mma with + | true => + let newlnum := remove X1 lnum in + build_monom newlnum lden + | false => build_monom lnum (consT ExprA X1 lden) + end + | ?X1 => + let mma := mem_assoc X1 lden in + match constr:mma with + | true => + let newlden := remove X1 lden in + build_monom lnum newlden + | false => build_monom (consT ExprA X1 lnum) lden + end + end. + +Ltac simpl_monom trm := simpl_monom_aux (nilT ExprA) (nilT ExprA) trm. + +Ltac simpl_all_monomials trm := + match constr:trm with + | (EAplus ?X1 ?X2) => + let e1 := simpl_monom X1 with e2 := simpl_all_monomials X2 in + constr:(EAplus e1 e2) + | ?X1 => simpl_monom X1 + end. (**** Associativity and distribution ****) -Meta Definition AssocDistrib trm := Eval Compute in (assoc (distrib trm)). +Ltac assoc_distrib trm := eval compute in (assoc (distrib trm)). (**** The tactic Field_Term ****) -Tactic Definition EvalWeakReduce trm := - Eval Cbv Beta Delta [interp_ExprA assoc_2nd eq_nat_dec mult_of_list A Azero - Aone Aplus Amult Aopp Ainv] Zeta Iota in trm. - -Tactic Definition Field_Term FT exp := - Let newexp = (InitExp FT exp) In - Let lvar = (BuildVarList FT newexp) In - Let trm = (interp_A FT lvar newexp) In - Let tma = Eval Compute in (assoc trm) In - Let tsmp = (SimplAllMonoms (AssocDistrib (SimplAllMonoms - (SimplInv tma)))) In - Let trep = (EvalWeakReduce '(interp_ExprA FT lvar tsmp)) In - Replace exp with trep;[Ring trep|Field_Gen FT]. +Ltac eval_weak_reduce trm := + eval + cbv beta iota zeta + delta [interp_ExprA assoc_2nd eq_nat_dec mult_of_list A Azero Aone Aplus + Amult Aopp Ainv] in trm. + +Ltac field_term FT exp := + let newexp := init_exp FT exp in + let lvar := build_varlist FT newexp in + let trm := interp_A FT lvar newexp in + let tma := eval compute in (assoc trm) in + let tsmp := + simpl_all_monomials + ltac:(assoc_distrib ltac:(simpl_all_monomials ltac:(simpl_inv tma))) in + let trep := eval_weak_reduce (interp_ExprA FT lvar tsmp) in + (replace exp with trep; [ ring trep | field_gen FT ]).
\ No newline at end of file diff --git a/contrib/field/Field_Theory.v b/contrib/field/Field_Theory.v index e2710260f..35f1125e4 100644 --- a/contrib/field/Field_Theory.v +++ b/contrib/field/Field_Theory.v @@ -8,86 +8,87 @@ (* $Id$ *) -Require Peano_dec. -Require Ring. -Require Field_Compl. - -Record Field_Theory : Type := -{ A : Type; - Aplus : A -> A -> A; - Amult : A -> A -> A; - Aone : A; - Azero : A; - Aopp : A -> A; - Aeq : A -> A -> bool; - Ainv : A -> A; - Aminus : (option A); - Adiv : (option A); - RT : (Ring_Theory Aplus Amult Aone Azero Aopp Aeq); - Th_inv_def : (n:A)~(n=Azero)->(Amult (Ainv n) n)=Aone -}. +Require Import Peano_dec. +Require Import Ring. +Require Import Field_Compl. + +Record Field_Theory : Type := + {A : Type; + Aplus : A -> A -> A; + Amult : A -> A -> A; + Aone : A; + Azero : A; + Aopp : A -> A; + Aeq : A -> A -> bool; + Ainv : A -> A; + Aminus : option A; + Adiv : option A; + RT : Ring_Theory Aplus Amult Aone Azero Aopp Aeq; + Th_inv_def : forall n:A, n <> Azero -> Amult (Ainv n) n = Aone}. (* The reflexion structure *) Inductive ExprA : Set := -| EAzero : ExprA -| EAone : ExprA -| EAplus : ExprA -> ExprA -> ExprA -| EAmult : ExprA -> ExprA -> ExprA -| EAopp : ExprA -> ExprA -| EAinv : ExprA -> ExprA -| EAvar : nat -> ExprA. + | EAzero : ExprA + | EAone : ExprA + | EAplus : ExprA -> ExprA -> ExprA + | EAmult : ExprA -> ExprA -> ExprA + | EAopp : ExprA -> ExprA + | EAinv : ExprA -> ExprA + | EAvar : nat -> ExprA. (**** Decidability of equality ****) -Lemma eqExprA_O:(e1,e2:ExprA){e1=e2}+{~e1=e2}. -Proof. - Double Induction e1 e2;Try Intros; - Try (Left;Reflexivity) Orelse Try (Right;Discriminate). - Elim (H1 e0);Intro y;Elim (H2 e);Intro y0; - Try (Left; Rewrite y; Rewrite y0;Auto) - Orelse (Right;Red;Intro;Inversion H3;Auto). - Elim (H1 e0);Intro y;Elim (H2 e);Intro y0; - Try (Left; Rewrite y; Rewrite y0;Auto) - Orelse (Right;Red;Intro;Inversion H3;Auto). - Elim (H0 e);Intro y. - Left; Rewrite y; Auto. - Right;Red; Intro;Inversion H1;Auto. - Elim (H0 e);Intro y. - Left; Rewrite y; Auto. - Right;Red; Intro;Inversion H1;Auto. - Elim (eq_nat_dec n n0);Intro y. - Left; Rewrite y; Auto. - Right;Red;Intro;Inversion H;Auto. +Lemma eqExprA_O : forall e1 e2:ExprA, {e1 = e2} + {e1 <> e2}. +Proof. + double induction e1 e2; try intros; + try (left; reflexivity) || (try (right; discriminate)). + elim (H1 e0); intro y; elim (H2 e); intro y0; + try + (left; rewrite y; rewrite y0; auto) || + (right; red in |- *; intro; inversion H3; auto). + elim (H1 e0); intro y; elim (H2 e); intro y0; + try + (left; rewrite y; rewrite y0; auto) || + (right; red in |- *; intro; inversion H3; auto). + elim (H0 e); intro y. + left; rewrite y; auto. + right; red in |- *; intro; inversion H1; auto. + elim (H0 e); intro y. + left; rewrite y; auto. + right; red in |- *; intro; inversion H1; auto. + elim (eq_nat_dec n n0); intro y. + left; rewrite y; auto. + right; red in |- *; intro; inversion H; auto. Defined. -Definition eq_nat_dec := Eval Compute in Peano_dec.eq_nat_dec. -Definition eqExprA := Eval Compute in eqExprA_O. +Definition eq_nat_dec := Eval compute in eq_nat_dec. +Definition eqExprA := Eval compute in eqExprA_O. (**** Generation of the multiplier ****) -Fixpoint mult_of_list [e:(listT ExprA)]: ExprA := - Cases e of +Fixpoint mult_of_list (e:listT ExprA) : ExprA := + match e with | nilT => EAone - | (consT e1 l1) => (EAmult e1 (mult_of_list l1)) + | consT e1 l1 => EAmult e1 (mult_of_list l1) end. Section Theory_of_fields. Variable T : Field_Theory. -Local AT := (A T). -Local AplusT := (Aplus T). -Local AmultT := (Amult T). -Local AoneT := (Aone T). -Local AzeroT := (Azero T). -Local AoppT := (Aopp T). -Local AeqT := (Aeq T). -Local AinvT := (Ainv T). -Local RTT := (RT T). -Local Th_inv_defT := (Th_inv_def T). +Let AT := A T. +Let AplusT := Aplus T. +Let AmultT := Amult T. +Let AoneT := Aone T. +Let AzeroT := Azero T. +Let AoppT := Aopp T. +Let AeqT := Aeq T. +Let AinvT := Ainv T. +Let RTT := RT T. +Let Th_inv_defT := Th_inv_def T. -Add Abstract Ring (A T) (Aplus T) (Amult T) (Aone T) (Azero T) (Aopp T) - (Aeq T) (RT T). +Add Abstract Ring (A T) (Aplus T) (Amult T) (Aone T) ( + Azero T) (Aopp T) (Aeq T) (RT T). Add Abstract Ring AT AplusT AmultT AoneT AzeroT AoppT AeqT RTT. @@ -95,93 +96,94 @@ Add Abstract Ring AT AplusT AmultT AoneT AzeroT AoppT AeqT RTT. (* Lemmas to be used *) (***************************) -Lemma AplusT_sym:(r1,r2:AT)(AplusT r1 r2)=(AplusT r2 r1). +Lemma AplusT_sym : forall r1 r2:AT, AplusT r1 r2 = AplusT r2 r1. Proof. - Intros;Ring. -Save. + intros; ring. +Qed. -Lemma AplusT_assoc:(r1,r2,r3:AT)(AplusT (AplusT r1 r2) r3)= - (AplusT r1 (AplusT r2 r3)). +Lemma AplusT_assoc : + forall r1 r2 r3:AT, AplusT (AplusT r1 r2) r3 = AplusT r1 (AplusT r2 r3). Proof. - Intros;Ring. -Save. + intros; ring. +Qed. -Lemma AmultT_sym:(r1,r2:AT)(AmultT r1 r2)=(AmultT r2 r1). +Lemma AmultT_sym : forall r1 r2:AT, AmultT r1 r2 = AmultT r2 r1. Proof. - Intros;Ring. -Save. + intros; ring. +Qed. -Lemma AmultT_assoc:(r1,r2,r3:AT)(AmultT (AmultT r1 r2) r3)= - (AmultT r1 (AmultT r2 r3)). +Lemma AmultT_assoc : + forall r1 r2 r3:AT, AmultT (AmultT r1 r2) r3 = AmultT r1 (AmultT r2 r3). Proof. - Intros;Ring. -Save. + intros; ring. +Qed. -Lemma AplusT_Ol:(r:AT)(AplusT AzeroT r)=r. +Lemma AplusT_Ol : forall r:AT, AplusT AzeroT r = r. Proof. - Intros;Ring. -Save. + intros; ring. +Qed. -Lemma AmultT_1l:(r:AT)(AmultT AoneT r)=r. +Lemma AmultT_1l : forall r:AT, AmultT AoneT r = r. Proof. - Intros;Ring. -Save. + intros; ring. +Qed. -Lemma AplusT_AoppT_r:(r:AT)(AplusT r (AoppT r))=AzeroT. +Lemma AplusT_AoppT_r : forall r:AT, AplusT r (AoppT r) = AzeroT. Proof. - Intros;Ring. -Save. + intros; ring. +Qed. -Lemma AmultT_AplusT_distr:(r1,r2,r3:AT)(AmultT r1 (AplusT r2 r3))= - (AplusT (AmultT r1 r2) (AmultT r1 r3)). +Lemma AmultT_AplusT_distr : + forall r1 r2 r3:AT, + AmultT r1 (AplusT r2 r3) = AplusT (AmultT r1 r2) (AmultT r1 r3). Proof. - Intros;Ring. -Save. + intros; ring. +Qed. -Lemma r_AplusT_plus:(r,r1,r2:AT)(AplusT r r1)=(AplusT r r2)->r1=r2. +Lemma r_AplusT_plus : forall r r1 r2:AT, AplusT r r1 = AplusT r r2 -> r1 = r2. Proof. - Intros; Transitivity (AplusT (AplusT (AoppT r) r) r1). - Ring. - Transitivity (AplusT (AplusT (AoppT r) r) r2). - Repeat Rewrite -> AplusT_assoc; Rewrite <- H; Reflexivity. - Ring. -Save. + intros; transitivity (AplusT (AplusT (AoppT r) r) r1). + ring. + transitivity (AplusT (AplusT (AoppT r) r) r2). + repeat rewrite AplusT_assoc; rewrite <- H; reflexivity. + ring. +Qed. -Lemma r_AmultT_mult: - (r,r1,r2:AT)(AmultT r r1)=(AmultT r r2)->~r=AzeroT->r1=r2. +Lemma r_AmultT_mult : + forall r r1 r2:AT, AmultT r r1 = AmultT r r2 -> r <> AzeroT -> r1 = r2. Proof. - Intros; Transitivity (AmultT (AmultT (AinvT r) r) r1). - Rewrite Th_inv_defT;[Symmetry; Apply AmultT_1l;Auto|Auto]. - Transitivity (AmultT (AmultT (AinvT r) r) r2). - Repeat Rewrite AmultT_assoc; Rewrite H; Trivial. - Rewrite Th_inv_defT;[Apply AmultT_1l;Auto|Auto]. -Save. + intros; transitivity (AmultT (AmultT (AinvT r) r) r1). + rewrite Th_inv_defT; [ symmetry in |- *; apply AmultT_1l; auto | auto ]. + transitivity (AmultT (AmultT (AinvT r) r) r2). + repeat rewrite AmultT_assoc; rewrite H; trivial. + rewrite Th_inv_defT; [ apply AmultT_1l; auto | auto ]. +Qed. -Lemma AmultT_Or:(r:AT) (AmultT r AzeroT)=AzeroT. +Lemma AmultT_Or : forall r:AT, AmultT r AzeroT = AzeroT. Proof. - Intro; Ring. -Save. + intro; ring. +Qed. -Lemma AmultT_Ol:(r:AT)(AmultT AzeroT r)=AzeroT. +Lemma AmultT_Ol : forall r:AT, AmultT AzeroT r = AzeroT. Proof. - Intro; Ring. -Save. + intro; ring. +Qed. -Lemma AmultT_1r:(r:AT)(AmultT r AoneT)=r. +Lemma AmultT_1r : forall r:AT, AmultT r AoneT = r. Proof. - Intro; Ring. -Save. + intro; ring. +Qed. -Lemma AinvT_r:(r:AT)~r=AzeroT->(AmultT r (AinvT r))=AoneT. +Lemma AinvT_r : forall r:AT, r <> AzeroT -> AmultT r (AinvT r) = AoneT. Proof. - Intros; Rewrite -> AmultT_sym; Apply Th_inv_defT; Auto. -Save. + intros; rewrite AmultT_sym; apply Th_inv_defT; auto. +Qed. -Lemma without_div_O_contr: - (r1,r2:AT)~(AmultT r1 r2)=AzeroT ->~r1=AzeroT/\~r2=AzeroT. +Lemma Rmult_neq_0_reg : + forall r1 r2:AT, AmultT r1 r2 <> AzeroT -> r1 <> AzeroT /\ r2 <> AzeroT. Proof. - Intros r1 r2 H; Split; Red; Intro; Apply H; Rewrite H0; Ring. -Save. + intros r1 r2 H; split; red in |- *; intro; apply H; rewrite H0; ring. +Qed. (************************) (* Interpretation *) @@ -189,15 +191,16 @@ Save. (**** ExprA --> A ****) -Fixpoint interp_ExprA [lvar:(listT (prodT AT nat));e:ExprA] : AT := - Cases e of - | EAzero => AzeroT - | EAone => AoneT - | (EAplus e1 e2) => (AplusT (interp_ExprA lvar e1) (interp_ExprA lvar e2)) - | (EAmult e1 e2) => (AmultT (interp_ExprA lvar e1) (interp_ExprA lvar e2)) - | (EAopp e) => ((Aopp T) (interp_ExprA lvar e)) - | (EAinv e) => ((Ainv T) (interp_ExprA lvar e)) - | (EAvar n) => (assoc_2nd AT nat eq_nat_dec lvar n AzeroT) +Fixpoint interp_ExprA (lvar:listT (prodT AT nat)) (e:ExprA) {struct e} : + AT := + match e with + | EAzero => AzeroT + | EAone => AoneT + | EAplus e1 e2 => AplusT (interp_ExprA lvar e1) (interp_ExprA lvar e2) + | EAmult e1 e2 => AmultT (interp_ExprA lvar e1) (interp_ExprA lvar e2) + | EAopp e => Aopp T (interp_ExprA lvar e) + | EAinv e => Ainv T (interp_ExprA lvar e) + | EAvar n => assoc_2nd AT nat eq_nat_dec lvar n AzeroT end. (************************) @@ -207,406 +210,436 @@ Fixpoint interp_ExprA [lvar:(listT (prodT AT nat));e:ExprA] : AT := (**** Associativity ****) Definition merge_mult := - Fix merge_mult {merge_mult [e1:ExprA] : ExprA -> ExprA := - [e2:ExprA]Cases e1 of - | (EAmult t1 t2) => - Cases t2 of - | (EAmult t2 t3) => (EAmult t1 (EAmult t2 (merge_mult t3 e2))) - | _ => (EAmult t1 (EAmult t2 e2)) - end - | _ => (EAmult e1 e2) - end}. - -Fixpoint assoc_mult [e:ExprA] : ExprA := - Cases e of - | (EAmult e1 e3) => - Cases e1 of - | (EAmult e1 e2) => - (merge_mult (merge_mult (assoc_mult e1) (assoc_mult e2)) - (assoc_mult e3)) - | _ => (EAmult e1 (assoc_mult e3)) - end + (fix merge_mult (e1:ExprA) : ExprA -> ExprA := + fun e2:ExprA => + match e1 with + | EAmult t1 t2 => + match t2 with + | EAmult t2 t3 => EAmult t1 (EAmult t2 (merge_mult t3 e2)) + | _ => EAmult t1 (EAmult t2 e2) + end + | _ => EAmult e1 e2 + end). + +Fixpoint assoc_mult (e:ExprA) : ExprA := + match e with + | EAmult e1 e3 => + match e1 with + | EAmult e1 e2 => + merge_mult (merge_mult (assoc_mult e1) (assoc_mult e2)) + (assoc_mult e3) + | _ => EAmult e1 (assoc_mult e3) + end | _ => e end. Definition merge_plus := - Fix merge_plus {merge_plus [e1:ExprA]:ExprA->ExprA:= - [e2:ExprA]Cases e1 of - | (EAplus t1 t2) => - Cases t2 of - | (EAplus t2 t3) => (EAplus t1 (EAplus t2 (merge_plus t3 e2))) - | _ => (EAplus t1 (EAplus t2 e2)) - end - | _ => (EAplus e1 e2) - end}. - -Fixpoint assoc [e:ExprA] : ExprA := - Cases e of - | (EAplus e1 e3) => - Cases e1 of - | (EAplus e1 e2) => - (merge_plus (merge_plus (assoc e1) (assoc e2)) (assoc e3)) - | _ => (EAplus (assoc_mult e1) (assoc e3)) - end - | _ => (assoc_mult e) + (fix merge_plus (e1:ExprA) : ExprA -> ExprA := + fun e2:ExprA => + match e1 with + | EAplus t1 t2 => + match t2 with + | EAplus t2 t3 => EAplus t1 (EAplus t2 (merge_plus t3 e2)) + | _ => EAplus t1 (EAplus t2 e2) + end + | _ => EAplus e1 e2 + end). + +Fixpoint assoc (e:ExprA) : ExprA := + match e with + | EAplus e1 e3 => + match e1 with + | EAplus e1 e2 => + merge_plus (merge_plus (assoc e1) (assoc e2)) (assoc e3) + | _ => EAplus (assoc_mult e1) (assoc e3) + end + | _ => assoc_mult e end. -Lemma merge_mult_correct1: - (e1,e2,e3:ExprA)(lvar:(listT (prodT AT nat))) - (interp_ExprA lvar (merge_mult (EAmult e1 e2) e3))= - (interp_ExprA lvar (EAmult e1 (merge_mult e2 e3))). -Proof. -Intros e1 e2;Generalize e1;Generalize e2;Clear e1 e2. -Induction e2;Auto;Intros. -Unfold 1 merge_mult;Fold merge_mult; - Unfold 2 interp_ExprA;Fold interp_ExprA; - Rewrite (H0 e e3 lvar); - Unfold 1 interp_ExprA;Fold interp_ExprA; - Unfold 5 interp_ExprA;Fold interp_ExprA;Auto. -Save. - -Lemma merge_mult_correct: - (e1,e2:ExprA)(lvar:(listT (prodT AT nat))) - (interp_ExprA lvar (merge_mult e1 e2))= - (interp_ExprA lvar (EAmult e1 e2)). -Proof. -Induction e1;Auto;Intros. -Elim e0;Try (Intros;Simpl;Ring). -Unfold interp_ExprA in H2;Fold interp_ExprA in H2; - Cut (AmultT (interp_ExprA lvar e2) (AmultT (interp_ExprA lvar e4) - (AmultT (interp_ExprA lvar e) (interp_ExprA lvar e3))))= - (AmultT (AmultT (AmultT (interp_ExprA lvar e) (interp_ExprA lvar e4)) - (interp_ExprA lvar e2)) (interp_ExprA lvar e3)). -Intro H3;Rewrite H3;Rewrite <-H2; - Rewrite merge_mult_correct1;Simpl;Ring. -Ring. -Save. - -Lemma assoc_mult_correct1:(e1,e2:ExprA)(lvar:(listT (prodT AT nat))) - (AmultT (interp_ExprA lvar (assoc_mult e1)) - (interp_ExprA lvar (assoc_mult e2)))= - (interp_ExprA lvar (assoc_mult (EAmult e1 e2))). -Proof. -Induction e1;Auto;Intros. -Rewrite <-(H e0 lvar);Simpl;Rewrite merge_mult_correct;Simpl; - Rewrite merge_mult_correct;Simpl;Auto. -Save. - -Lemma assoc_mult_correct: - (e:ExprA)(lvar:(listT (prodT AT nat))) - (interp_ExprA lvar (assoc_mult e))=(interp_ExprA lvar e). -Proof. -Induction e;Auto;Intros. -Elim e0;Intros. -Intros;Simpl;Ring. -Simpl;Rewrite (AmultT_1l (interp_ExprA lvar (assoc_mult e1))); - Rewrite (AmultT_1l (interp_ExprA lvar e1)); Apply H0. -Simpl;Rewrite (H0 lvar);Auto. -Simpl;Rewrite merge_mult_correct;Simpl;Rewrite merge_mult_correct;Simpl; - Rewrite AmultT_assoc;Rewrite assoc_mult_correct1;Rewrite H2;Simpl; - Rewrite <-assoc_mult_correct1 in H1; - Unfold 3 interp_ExprA in H1;Fold interp_ExprA in H1; - Rewrite (H0 lvar) in H1; - Rewrite (AmultT_sym (interp_ExprA lvar e3) (interp_ExprA lvar e1)); - Rewrite <-AmultT_assoc;Rewrite H1;Rewrite AmultT_assoc;Ring. -Simpl;Rewrite (H0 lvar);Auto. -Simpl;Rewrite (H0 lvar);Auto. -Simpl;Rewrite (H0 lvar);Auto. -Save. - -Lemma merge_plus_correct1: - (e1,e2,e3:ExprA)(lvar:(listT (prodT AT nat))) - (interp_ExprA lvar (merge_plus (EAplus e1 e2) e3))= - (interp_ExprA lvar (EAplus e1 (merge_plus e2 e3))). -Proof. -Intros e1 e2;Generalize e1;Generalize e2;Clear e1 e2. -Induction e2;Auto;Intros. -Unfold 1 merge_plus;Fold merge_plus; - Unfold 2 interp_ExprA;Fold interp_ExprA; - Rewrite (H0 e e3 lvar); - Unfold 1 interp_ExprA;Fold interp_ExprA; - Unfold 5 interp_ExprA;Fold interp_ExprA;Auto. -Save. - -Lemma merge_plus_correct: - (e1,e2:ExprA)(lvar:(listT (prodT AT nat))) - (interp_ExprA lvar (merge_plus e1 e2))= - (interp_ExprA lvar (EAplus e1 e2)). -Proof. -Induction e1;Auto;Intros. -Elim e0;Try Intros;Try (Simpl;Ring). -Unfold interp_ExprA in H2;Fold interp_ExprA in H2; - Cut (AplusT (interp_ExprA lvar e2) (AplusT (interp_ExprA lvar e4) - (AplusT (interp_ExprA lvar e) (interp_ExprA lvar e3))))= - (AplusT (AplusT (AplusT (interp_ExprA lvar e) (interp_ExprA lvar e4)) - (interp_ExprA lvar e2)) (interp_ExprA lvar e3)). -Intro H3;Rewrite H3;Rewrite <-H2;Rewrite merge_plus_correct1;Simpl;Ring. -Ring. -Save. - -Lemma assoc_plus_correct:(e1,e2:ExprA)(lvar:(listT (prodT AT nat))) - (AplusT (interp_ExprA lvar (assoc e1)) (interp_ExprA lvar (assoc e2)))= - (interp_ExprA lvar (assoc (EAplus e1 e2))). -Proof. -Induction e1;Auto;Intros. -Rewrite <-(H e0 lvar);Simpl;Rewrite merge_plus_correct;Simpl; - Rewrite merge_plus_correct;Simpl;Auto. -Save. - -Lemma assoc_correct: - (e:ExprA)(lvar:(listT (prodT AT nat))) - (interp_ExprA lvar (assoc e))=(interp_ExprA lvar e). -Proof. -Induction e;Auto;Intros. -Elim e0;Intros. -Simpl;Rewrite (H0 lvar);Auto. -Simpl;Rewrite (H0 lvar);Auto. -Simpl;Rewrite merge_plus_correct;Simpl;Rewrite merge_plus_correct; - Simpl;Rewrite AplusT_assoc;Rewrite assoc_plus_correct;Rewrite H2; - Simpl;Apply (r_AplusT_plus (interp_ExprA lvar (assoc e1)) - (AplusT (interp_ExprA lvar (assoc e2)) - (AplusT (interp_ExprA lvar e3) (interp_ExprA lvar e1))) - (AplusT (AplusT (interp_ExprA lvar e2) (interp_ExprA lvar e3)) - (interp_ExprA lvar e1)));Rewrite <-AplusT_assoc; - Rewrite (AplusT_sym (interp_ExprA lvar (assoc e1)) - (interp_ExprA lvar (assoc e2))); - Rewrite assoc_plus_correct;Rewrite H1;Simpl;Rewrite (H0 lvar); - Rewrite <-(AplusT_assoc (AplusT (interp_ExprA lvar e2) - (interp_ExprA lvar e1)) - (interp_ExprA lvar e3) (interp_ExprA lvar e1)); - Rewrite (AplusT_assoc (interp_ExprA lvar e2) (interp_ExprA lvar e1) - (interp_ExprA lvar e3)); - Rewrite (AplusT_sym (interp_ExprA lvar e1) (interp_ExprA lvar e3)); - Rewrite <-(AplusT_assoc (interp_ExprA lvar e2) (interp_ExprA lvar e3) - (interp_ExprA lvar e1));Apply AplusT_sym. -Unfold assoc;Fold assoc;Unfold interp_ExprA;Fold interp_ExprA; - Rewrite assoc_mult_correct;Rewrite (H0 lvar);Simpl;Auto. -Simpl;Rewrite (H0 lvar);Auto. -Simpl;Rewrite (H0 lvar);Auto. -Simpl;Rewrite (H0 lvar);Auto. -Unfold assoc;Fold assoc;Unfold interp_ExprA;Fold interp_ExprA; - Rewrite assoc_mult_correct;Simpl;Auto. -Save. +Lemma merge_mult_correct1 : + forall (e1 e2 e3:ExprA) (lvar:listT (prodT AT nat)), + interp_ExprA lvar (merge_mult (EAmult e1 e2) e3) = + interp_ExprA lvar (EAmult e1 (merge_mult e2 e3)). +Proof. +intros e1 e2; generalize e1; generalize e2; clear e1 e2. +simple induction e2; auto; intros. +unfold merge_mult at 1 in |- *; fold merge_mult in |- *; + unfold interp_ExprA at 2 in |- *; fold interp_ExprA in |- *; + rewrite (H0 e e3 lvar); unfold interp_ExprA at 1 in |- *; + fold interp_ExprA in |- *; unfold interp_ExprA at 5 in |- *; + fold interp_ExprA in |- *; auto. +Qed. + +Lemma merge_mult_correct : + forall (e1 e2:ExprA) (lvar:listT (prodT AT nat)), + interp_ExprA lvar (merge_mult e1 e2) = interp_ExprA lvar (EAmult e1 e2). +Proof. +simple induction e1; auto; intros. +elim e0; try (intros; simpl in |- *; ring). +unfold interp_ExprA in H2; fold interp_ExprA in H2; + cut + (AmultT (interp_ExprA lvar e2) + (AmultT (interp_ExprA lvar e4) + (AmultT (interp_ExprA lvar e) (interp_ExprA lvar e3))) = + AmultT + (AmultT (AmultT (interp_ExprA lvar e) (interp_ExprA lvar e4)) + (interp_ExprA lvar e2)) (interp_ExprA lvar e3)). +intro H3; rewrite H3; rewrite <- H2; rewrite merge_mult_correct1; + simpl in |- *; ring. +ring. +Qed. + +Lemma assoc_mult_correct1 : + forall (e1 e2:ExprA) (lvar:listT (prodT AT nat)), + AmultT (interp_ExprA lvar (assoc_mult e1)) + (interp_ExprA lvar (assoc_mult e2)) = + interp_ExprA lvar (assoc_mult (EAmult e1 e2)). +Proof. +simple induction e1; auto; intros. +rewrite <- (H e0 lvar); simpl in |- *; rewrite merge_mult_correct; + simpl in |- *; rewrite merge_mult_correct; simpl in |- *; + auto. +Qed. + +Lemma assoc_mult_correct : + forall (e:ExprA) (lvar:listT (prodT AT nat)), + interp_ExprA lvar (assoc_mult e) = interp_ExprA lvar e. +Proof. +simple induction e; auto; intros. +elim e0; intros. +intros; simpl in |- *; ring. +simpl in |- *; rewrite (AmultT_1l (interp_ExprA lvar (assoc_mult e1))); + rewrite (AmultT_1l (interp_ExprA lvar e1)); apply H0. +simpl in |- *; rewrite (H0 lvar); auto. +simpl in |- *; rewrite merge_mult_correct; simpl in |- *; + rewrite merge_mult_correct; simpl in |- *; rewrite AmultT_assoc; + rewrite assoc_mult_correct1; rewrite H2; simpl in |- *; + rewrite <- assoc_mult_correct1 in H1; unfold interp_ExprA at 3 in H1; + fold interp_ExprA in H1; rewrite (H0 lvar) in H1; + rewrite (AmultT_sym (interp_ExprA lvar e3) (interp_ExprA lvar e1)); + rewrite <- AmultT_assoc; rewrite H1; rewrite AmultT_assoc; + ring. +simpl in |- *; rewrite (H0 lvar); auto. +simpl in |- *; rewrite (H0 lvar); auto. +simpl in |- *; rewrite (H0 lvar); auto. +Qed. + +Lemma merge_plus_correct1 : + forall (e1 e2 e3:ExprA) (lvar:listT (prodT AT nat)), + interp_ExprA lvar (merge_plus (EAplus e1 e2) e3) = + interp_ExprA lvar (EAplus e1 (merge_plus e2 e3)). +Proof. +intros e1 e2; generalize e1; generalize e2; clear e1 e2. +simple induction e2; auto; intros. +unfold merge_plus at 1 in |- *; fold merge_plus in |- *; + unfold interp_ExprA at 2 in |- *; fold interp_ExprA in |- *; + rewrite (H0 e e3 lvar); unfold interp_ExprA at 1 in |- *; + fold interp_ExprA in |- *; unfold interp_ExprA at 5 in |- *; + fold interp_ExprA in |- *; auto. +Qed. + +Lemma merge_plus_correct : + forall (e1 e2:ExprA) (lvar:listT (prodT AT nat)), + interp_ExprA lvar (merge_plus e1 e2) = interp_ExprA lvar (EAplus e1 e2). +Proof. +simple induction e1; auto; intros. +elim e0; try intros; try (simpl in |- *; ring). +unfold interp_ExprA in H2; fold interp_ExprA in H2; + cut + (AplusT (interp_ExprA lvar e2) + (AplusT (interp_ExprA lvar e4) + (AplusT (interp_ExprA lvar e) (interp_ExprA lvar e3))) = + AplusT + (AplusT (AplusT (interp_ExprA lvar e) (interp_ExprA lvar e4)) + (interp_ExprA lvar e2)) (interp_ExprA lvar e3)). +intro H3; rewrite H3; rewrite <- H2; rewrite merge_plus_correct1; + simpl in |- *; ring. +ring. +Qed. + +Lemma assoc_plus_correct : + forall (e1 e2:ExprA) (lvar:listT (prodT AT nat)), + AplusT (interp_ExprA lvar (assoc e1)) (interp_ExprA lvar (assoc e2)) = + interp_ExprA lvar (assoc (EAplus e1 e2)). +Proof. +simple induction e1; auto; intros. +rewrite <- (H e0 lvar); simpl in |- *; rewrite merge_plus_correct; + simpl in |- *; rewrite merge_plus_correct; simpl in |- *; + auto. +Qed. + +Lemma assoc_correct : + forall (e:ExprA) (lvar:listT (prodT AT nat)), + interp_ExprA lvar (assoc e) = interp_ExprA lvar e. +Proof. +simple induction e; auto; intros. +elim e0; intros. +simpl in |- *; rewrite (H0 lvar); auto. +simpl in |- *; rewrite (H0 lvar); auto. +simpl in |- *; rewrite merge_plus_correct; simpl in |- *; + rewrite merge_plus_correct; simpl in |- *; rewrite AplusT_assoc; + rewrite assoc_plus_correct; rewrite H2; simpl in |- *; + apply + (r_AplusT_plus (interp_ExprA lvar (assoc e1)) + (AplusT (interp_ExprA lvar (assoc e2)) + (AplusT (interp_ExprA lvar e3) (interp_ExprA lvar e1))) + (AplusT (AplusT (interp_ExprA lvar e2) (interp_ExprA lvar e3)) + (interp_ExprA lvar e1))); rewrite <- AplusT_assoc; + rewrite + (AplusT_sym (interp_ExprA lvar (assoc e1)) (interp_ExprA lvar (assoc e2))) + ; rewrite assoc_plus_correct; rewrite H1; simpl in |- *; + rewrite (H0 lvar); + rewrite <- + (AplusT_assoc (AplusT (interp_ExprA lvar e2) (interp_ExprA lvar e1)) + (interp_ExprA lvar e3) (interp_ExprA lvar e1)) + ; + rewrite + (AplusT_assoc (interp_ExprA lvar e2) (interp_ExprA lvar e1) + (interp_ExprA lvar e3)); + rewrite (AplusT_sym (interp_ExprA lvar e1) (interp_ExprA lvar e3)); + rewrite <- + (AplusT_assoc (interp_ExprA lvar e2) (interp_ExprA lvar e3) + (interp_ExprA lvar e1)); apply AplusT_sym. +unfold assoc in |- *; fold assoc in |- *; unfold interp_ExprA in |- *; + fold interp_ExprA in |- *; rewrite assoc_mult_correct; + rewrite (H0 lvar); simpl in |- *; auto. +simpl in |- *; rewrite (H0 lvar); auto. +simpl in |- *; rewrite (H0 lvar); auto. +simpl in |- *; rewrite (H0 lvar); auto. +unfold assoc in |- *; fold assoc in |- *; unfold interp_ExprA in |- *; + fold interp_ExprA in |- *; rewrite assoc_mult_correct; + simpl in |- *; auto. +Qed. (**** Distribution *****) -Fixpoint distrib_EAopp [e:ExprA] : ExprA := - Cases e of - | (EAplus e1 e2) => (EAplus (distrib_EAopp e1) (distrib_EAopp e2)) - | (EAmult e1 e2) => (EAmult (distrib_EAopp e1) (distrib_EAopp e2)) - | (EAopp e) => (EAmult (EAopp EAone) (distrib_EAopp e)) +Fixpoint distrib_EAopp (e:ExprA) : ExprA := + match e with + | EAplus e1 e2 => EAplus (distrib_EAopp e1) (distrib_EAopp e2) + | EAmult e1 e2 => EAmult (distrib_EAopp e1) (distrib_EAopp e2) + | EAopp e => EAmult (EAopp EAone) (distrib_EAopp e) | e => e end. Definition distrib_mult_right := - Fix distrib_mult_right {distrib_mult_right [e1:ExprA]:ExprA->ExprA:= - [e2:ExprA]Cases e1 of - | (EAplus t1 t2) => - (EAplus (distrib_mult_right t1 e2) (distrib_mult_right t2 e2)) - | _ => (EAmult e1 e2) - end}. - -Fixpoint distrib_mult_left [e1:ExprA] : ExprA->ExprA := - [e2:ExprA] - Cases e1 of - | (EAplus t1 t2) => - (EAplus (distrib_mult_left t1 e2) (distrib_mult_left t2 e2)) - | _ => (distrib_mult_right e2 e1) + (fix distrib_mult_right (e1:ExprA) : ExprA -> ExprA := + fun e2:ExprA => + match e1 with + | EAplus t1 t2 => + EAplus (distrib_mult_right t1 e2) (distrib_mult_right t2 e2) + | _ => EAmult e1 e2 + end). + +Fixpoint distrib_mult_left (e1 e2:ExprA) {struct e1} : ExprA := + match e1 with + | EAplus t1 t2 => + EAplus (distrib_mult_left t1 e2) (distrib_mult_left t2 e2) + | _ => distrib_mult_right e2 e1 end. -Fixpoint distrib_main [e:ExprA] : ExprA := - Cases e of - | (EAmult e1 e2) => (distrib_mult_left (distrib_main e1) (distrib_main e2)) - | (EAplus e1 e2) => (EAplus (distrib_main e1) (distrib_main e2)) - | (EAopp e) => (EAopp (distrib_main e)) +Fixpoint distrib_main (e:ExprA) : ExprA := + match e with + | EAmult e1 e2 => distrib_mult_left (distrib_main e1) (distrib_main e2) + | EAplus e1 e2 => EAplus (distrib_main e1) (distrib_main e2) + | EAopp e => EAopp (distrib_main e) | _ => e end. -Definition distrib [e:ExprA] : ExprA := (distrib_main (distrib_EAopp e)). - -Lemma distrib_mult_right_correct: - (e1,e2:ExprA)(lvar:(listT (prodT AT nat))) - (interp_ExprA lvar (distrib_mult_right e1 e2))= - (AmultT (interp_ExprA lvar e1) (interp_ExprA lvar e2)). -Proof. -Induction e1;Try Intros;Simpl;Auto. -Rewrite AmultT_sym;Rewrite AmultT_AplusT_distr; - Rewrite (H e2 lvar);Rewrite (H0 e2 lvar);Ring. -Save. - -Lemma distrib_mult_left_correct: - (e1,e2:ExprA)(lvar:(listT (prodT AT nat))) - (interp_ExprA lvar (distrib_mult_left e1 e2))= - (AmultT (interp_ExprA lvar e1) (interp_ExprA lvar e2)). -Proof. -Induction e1;Try Intros;Simpl. -Rewrite AmultT_Ol;Rewrite distrib_mult_right_correct;Simpl;Apply AmultT_Or. -Rewrite distrib_mult_right_correct;Simpl; - Apply AmultT_sym. -Rewrite AmultT_sym; - Rewrite (AmultT_AplusT_distr (interp_ExprA lvar e2) (interp_ExprA lvar e) - (interp_ExprA lvar e0)); - Rewrite (AmultT_sym (interp_ExprA lvar e2) (interp_ExprA lvar e)); - Rewrite (AmultT_sym (interp_ExprA lvar e2) (interp_ExprA lvar e0)); - Rewrite (H e2 lvar);Rewrite (H0 e2 lvar);Auto. -Rewrite distrib_mult_right_correct;Simpl;Apply AmultT_sym. -Rewrite distrib_mult_right_correct;Simpl;Apply AmultT_sym. -Rewrite distrib_mult_right_correct;Simpl;Apply AmultT_sym. -Rewrite distrib_mult_right_correct;Simpl;Apply AmultT_sym. -Save. - -Lemma distrib_correct: - (e:ExprA)(lvar:(listT (prodT AT nat))) - (interp_ExprA lvar (distrib e))=(interp_ExprA lvar e). -Proof. -Induction e;Intros;Auto. -Simpl;Rewrite <- (H lvar);Rewrite <- (H0 lvar); Unfold distrib;Simpl;Auto. -Simpl;Rewrite <- (H lvar);Rewrite <- (H0 lvar); Unfold distrib;Simpl; - Apply distrib_mult_left_correct. -Simpl;Fold AoppT;Rewrite <- (H lvar);Unfold distrib;Simpl; - Rewrite distrib_mult_right_correct; - Simpl;Fold AoppT;Ring. -Save. +Definition distrib (e:ExprA) : ExprA := distrib_main (distrib_EAopp e). + +Lemma distrib_mult_right_correct : + forall (e1 e2:ExprA) (lvar:listT (prodT AT nat)), + interp_ExprA lvar (distrib_mult_right e1 e2) = + AmultT (interp_ExprA lvar e1) (interp_ExprA lvar e2). +Proof. +simple induction e1; try intros; simpl in |- *; auto. +rewrite AmultT_sym; rewrite AmultT_AplusT_distr; rewrite (H e2 lvar); + rewrite (H0 e2 lvar); ring. +Qed. + +Lemma distrib_mult_left_correct : + forall (e1 e2:ExprA) (lvar:listT (prodT AT nat)), + interp_ExprA lvar (distrib_mult_left e1 e2) = + AmultT (interp_ExprA lvar e1) (interp_ExprA lvar e2). +Proof. +simple induction e1; try intros; simpl in |- *. +rewrite AmultT_Ol; rewrite distrib_mult_right_correct; simpl in |- *; + apply AmultT_Or. +rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_sym. +rewrite AmultT_sym; + rewrite + (AmultT_AplusT_distr (interp_ExprA lvar e2) (interp_ExprA lvar e) + (interp_ExprA lvar e0)); + rewrite (AmultT_sym (interp_ExprA lvar e2) (interp_ExprA lvar e)); + rewrite (AmultT_sym (interp_ExprA lvar e2) (interp_ExprA lvar e0)); + rewrite (H e2 lvar); rewrite (H0 e2 lvar); auto. +rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_sym. +rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_sym. +rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_sym. +rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_sym. +Qed. + +Lemma distrib_correct : + forall (e:ExprA) (lvar:listT (prodT AT nat)), + interp_ExprA lvar (distrib e) = interp_ExprA lvar e. +Proof. +simple induction e; intros; auto. +simpl in |- *; rewrite <- (H lvar); rewrite <- (H0 lvar); + unfold distrib in |- *; simpl in |- *; auto. +simpl in |- *; rewrite <- (H lvar); rewrite <- (H0 lvar); + unfold distrib in |- *; simpl in |- *; apply distrib_mult_left_correct. +simpl in |- *; fold AoppT in |- *; rewrite <- (H lvar); + unfold distrib in |- *; simpl in |- *; rewrite distrib_mult_right_correct; + simpl in |- *; fold AoppT in |- *; ring. +Qed. (**** Multiplication by the inverse product ****) -Lemma mult_eq: - (e1,e2,a:ExprA)(lvar:(listT (prodT AT nat))) - ~((interp_ExprA lvar a)=AzeroT)-> - (interp_ExprA lvar (EAmult a e1))=(interp_ExprA lvar (EAmult a e2))-> - (interp_ExprA lvar e1)=(interp_ExprA lvar e2). -Proof. - Simpl;Intros; - Apply (r_AmultT_mult (interp_ExprA lvar a) (interp_ExprA lvar e1) - (interp_ExprA lvar e2));Assumption. -Save. - -Fixpoint multiply_aux [a,e:ExprA] : ExprA := - Cases e of - | (EAplus e1 e2) => - (EAplus (EAmult a e1) (multiply_aux a e2)) - | _ => (EAmult a e) +Lemma mult_eq : + forall (e1 e2 a:ExprA) (lvar:listT (prodT AT nat)), + interp_ExprA lvar a <> AzeroT -> + interp_ExprA lvar (EAmult a e1) = interp_ExprA lvar (EAmult a e2) -> + interp_ExprA lvar e1 = interp_ExprA lvar e2. +Proof. + simpl in |- *; intros; + apply + (r_AmultT_mult (interp_ExprA lvar a) (interp_ExprA lvar e1) + (interp_ExprA lvar e2)); assumption. +Qed. + +Fixpoint multiply_aux (a e:ExprA) {struct e} : ExprA := + match e with + | EAplus e1 e2 => EAplus (EAmult a e1) (multiply_aux a e2) + | _ => EAmult a e end. -Definition multiply [e:ExprA] : ExprA := - Cases e of - | (EAmult a e1) => (multiply_aux a e1) +Definition multiply (e:ExprA) : ExprA := + match e with + | EAmult a e1 => multiply_aux a e1 | _ => e end. -Lemma multiply_aux_correct: - (a,e:ExprA)(lvar:(listT (prodT AT nat))) - (interp_ExprA lvar (multiply_aux a e))= - (AmultT (interp_ExprA lvar a) (interp_ExprA lvar e)). +Lemma multiply_aux_correct : + forall (a e:ExprA) (lvar:listT (prodT AT nat)), + interp_ExprA lvar (multiply_aux a e) = + AmultT (interp_ExprA lvar a) (interp_ExprA lvar e). Proof. -Induction e;Simpl;Intros;Try (Rewrite merge_mult_correct);Auto. - Simpl;Rewrite (H0 lvar);Ring. -Save. +simple induction e; simpl in |- *; intros; try rewrite merge_mult_correct; + auto. + simpl in |- *; rewrite (H0 lvar); ring. +Qed. -Lemma multiply_correct: - (e:ExprA)(lvar:(listT (prodT AT nat))) - (interp_ExprA lvar (multiply e))=(interp_ExprA lvar e). +Lemma multiply_correct : + forall (e:ExprA) (lvar:listT (prodT AT nat)), + interp_ExprA lvar (multiply e) = interp_ExprA lvar e. Proof. - Induction e;Simpl;Auto. - Intros;Apply multiply_aux_correct. -Save. + simple induction e; simpl in |- *; auto. + intros; apply multiply_aux_correct. +Qed. (**** Permutations and simplification ****) -Fixpoint monom_remove [a,m:ExprA] : ExprA := - Cases m of - | (EAmult m0 m1) => - (Cases (eqExprA m0 (EAinv a)) of - | (left _) => m1 - | (right _) => (EAmult m0 (monom_remove a m1)) - end) +Fixpoint monom_remove (a m:ExprA) {struct m} : ExprA := + match m with + | EAmult m0 m1 => + match eqExprA m0 (EAinv a) with + | left _ => m1 + | right _ => EAmult m0 (monom_remove a m1) + end | _ => - (Cases (eqExprA m (EAinv a)) of - | (left _) => EAone - | (right _) => (EAmult a m) - end) + match eqExprA m (EAinv a) with + | left _ => EAone + | right _ => EAmult a m + end end. -Definition monom_simplif_rem := - Fix monom_simplif_rem {monom_simplif_rem/1:ExprA->ExprA->ExprA:= - [a,m:ExprA] - Cases a of - | (EAmult a0 a1) => (monom_simplif_rem a1 (monom_remove a0 m)) - | _ => (monom_remove a m) - end}. - -Definition monom_simplif [a,m:ExprA] : ExprA := - Cases m of - | (EAmult a' m') => - (Cases (eqExprA a a') of - | (left _) => (monom_simplif_rem a m') - | (right _) => m - end) +Definition monom_simplif_rem := + (fix monom_simplif_rem (a:ExprA) : ExprA -> ExprA := + fun m:ExprA => + match a with + | EAmult a0 a1 => monom_simplif_rem a1 (monom_remove a0 m) + | _ => monom_remove a m + end). + +Definition monom_simplif (a m:ExprA) : ExprA := + match m with + | EAmult a' m' => + match eqExprA a a' with + | left _ => monom_simplif_rem a m' + | right _ => m + end | _ => m end. -Fixpoint inverse_simplif [a,e:ExprA] : ExprA := - Cases e of - | (EAplus e1 e2) => (EAplus (monom_simplif a e1) (inverse_simplif a e2)) - | _ => (monom_simplif a e) +Fixpoint inverse_simplif (a e:ExprA) {struct e} : ExprA := + match e with + | EAplus e1 e2 => EAplus (monom_simplif a e1) (inverse_simplif a e2) + | _ => monom_simplif a e end. -Lemma monom_remove_correct:(e,a:ExprA) - (lvar:(listT (prodT AT nat)))~((interp_ExprA lvar a)=AzeroT)-> - (interp_ExprA lvar (monom_remove a e))= - (AmultT (interp_ExprA lvar a) (interp_ExprA lvar e)). -Proof. -Induction e; Intros. -Simpl;Case (eqExprA EAzero (EAinv a));Intros;[Inversion e0|Simpl;Trivial]. -Simpl;Case (eqExprA EAone (EAinv a));Intros;[Inversion e0|Simpl;Trivial]. -Simpl;Case (eqExprA (EAplus e0 e1) (EAinv a));Intros;[Inversion e2| - Simpl;Trivial]. -Simpl;Case (eqExprA e0 (EAinv a));Intros. -Rewrite e2;Simpl;Fold AinvT. -Rewrite <-(AmultT_assoc (interp_ExprA lvar a) (AinvT (interp_ExprA lvar a)) - (interp_ExprA lvar e1)); - Rewrite AinvT_r;[Ring|Assumption]. -Simpl;Rewrite H0;Auto; Ring. -Simpl;Fold AoppT;Case (eqExprA (EAopp e0) (EAinv a));Intros;[Inversion e1| - Simpl;Trivial]. -Unfold monom_remove;Case (eqExprA (EAinv e0) (EAinv a));Intros. -Case (eqExprA e0 a);Intros. -Rewrite e2;Simpl;Fold AinvT;Rewrite AinvT_r;Auto. -Inversion e1;Simpl;ElimType False;Auto. -Simpl;Trivial. -Unfold monom_remove;Case (eqExprA (EAvar n) (EAinv a));Intros; - [Inversion e0|Simpl;Trivial]. -Save. - -Lemma monom_simplif_rem_correct:(a,e:ExprA) - (lvar:(listT (prodT AT nat)))~((interp_ExprA lvar a)=AzeroT)-> - (interp_ExprA lvar (monom_simplif_rem a e))= - (AmultT (interp_ExprA lvar a) (interp_ExprA lvar e)). -Proof. -Induction a;Simpl;Intros; Try Rewrite monom_remove_correct;Auto. -Elim (without_div_O_contr (interp_ExprA lvar e) - (interp_ExprA lvar e0) H1);Intros. -Rewrite (H0 (monom_remove e e1) lvar H3);Rewrite monom_remove_correct;Auto. -Ring. -Save. - -Lemma monom_simplif_correct:(e,a:ExprA) - (lvar:(listT (prodT AT nat)))~((interp_ExprA lvar a)=AzeroT)-> - (interp_ExprA lvar (monom_simplif a e))=(interp_ExprA lvar e). -Proof. -Induction e;Intros;Auto. -Simpl;Case (eqExprA a e0);Intros. -Rewrite <-e2;Apply monom_simplif_rem_correct;Auto. -Simpl;Trivial. -Save. - -Lemma inverse_correct: - (e,a:ExprA)(lvar:(listT (prodT AT nat)))~((interp_ExprA lvar a)=AzeroT)-> - (interp_ExprA lvar (inverse_simplif a e))=(interp_ExprA lvar e). -Proof. -Induction e;Intros;Auto. -Simpl;Rewrite (H0 a lvar H1); Rewrite monom_simplif_correct ; Auto. -Unfold inverse_simplif;Rewrite monom_simplif_correct ; Auto. -Save. - -End Theory_of_fields. +Lemma monom_remove_correct : + forall (e a:ExprA) (lvar:listT (prodT AT nat)), + interp_ExprA lvar a <> AzeroT -> + interp_ExprA lvar (monom_remove a e) = + AmultT (interp_ExprA lvar a) (interp_ExprA lvar e). +Proof. +simple induction e; intros. +simpl in |- *; case (eqExprA EAzero (EAinv a)); intros; + [ inversion e0 | simpl in |- *; trivial ]. +simpl in |- *; case (eqExprA EAone (EAinv a)); intros; + [ inversion e0 | simpl in |- *; trivial ]. +simpl in |- *; case (eqExprA (EAplus e0 e1) (EAinv a)); intros; + [ inversion e2 | simpl in |- *; trivial ]. +simpl in |- *; case (eqExprA e0 (EAinv a)); intros. +rewrite e2; simpl in |- *; fold AinvT in |- *. +rewrite <- + (AmultT_assoc (interp_ExprA lvar a) (AinvT (interp_ExprA lvar a)) + (interp_ExprA lvar e1)); rewrite AinvT_r; [ ring | assumption ]. +simpl in |- *; rewrite H0; auto; ring. +simpl in |- *; fold AoppT in |- *; case (eqExprA (EAopp e0) (EAinv a)); + intros; [ inversion e1 | simpl in |- *; trivial ]. +unfold monom_remove in |- *; case (eqExprA (EAinv e0) (EAinv a)); intros. +case (eqExprA e0 a); intros. +rewrite e2; simpl in |- *; fold AinvT in |- *; rewrite AinvT_r; auto. +inversion e1; simpl in |- *; elimtype False; auto. +simpl in |- *; trivial. +unfold monom_remove in |- *; case (eqExprA (EAvar n) (EAinv a)); intros; + [ inversion e0 | simpl in |- *; trivial ]. +Qed. + +Lemma monom_simplif_rem_correct : + forall (a e:ExprA) (lvar:listT (prodT AT nat)), + interp_ExprA lvar a <> AzeroT -> + interp_ExprA lvar (monom_simplif_rem a e) = + AmultT (interp_ExprA lvar a) (interp_ExprA lvar e). +Proof. +simple induction a; simpl in |- *; intros; try rewrite monom_remove_correct; + auto. +elim (Rmult_neq_0_reg (interp_ExprA lvar e) (interp_ExprA lvar e0) H1); + intros. +rewrite (H0 (monom_remove e e1) lvar H3); rewrite monom_remove_correct; auto. +ring. +Qed. + +Lemma monom_simplif_correct : + forall (e a:ExprA) (lvar:listT (prodT AT nat)), + interp_ExprA lvar a <> AzeroT -> + interp_ExprA lvar (monom_simplif a e) = interp_ExprA lvar e. +Proof. +simple induction e; intros; auto. +simpl in |- *; case (eqExprA a e0); intros. +rewrite <- e2; apply monom_simplif_rem_correct; auto. +simpl in |- *; trivial. +Qed. + +Lemma inverse_correct : + forall (e a:ExprA) (lvar:listT (prodT AT nat)), + interp_ExprA lvar a <> AzeroT -> + interp_ExprA lvar (inverse_simplif a e) = interp_ExprA lvar e. +Proof. +simple induction e; intros; auto. +simpl in |- *; rewrite (H0 a lvar H1); rewrite monom_simplif_correct; auto. +unfold inverse_simplif in |- *; rewrite monom_simplif_correct; auto. +Qed. + +End Theory_of_fields.
\ No newline at end of file diff --git a/contrib/fourier/Fourier.v b/contrib/fourier/Fourier.v index b02688de6..d55092759 100644 --- a/contrib/fourier/Fourier.v +++ b/contrib/fourier/Fourier.v @@ -20,9 +20,6 @@ Require Export Fourier_util. Require Export Field. Require Export DiscrR. -Tactic Definition Fourier := - Abstract (FourierZ;Field;DiscrR). - -Tactic Definition FourierEq := - Apply Rge_ge_eq ; Fourier. +Ltac fourier := abstract (fourierz; field; discrR). +Ltac fourier_eq := apply Rge_antisym; fourier. diff --git a/contrib/fourier/Fourier_util.v b/contrib/fourier/Fourier_util.v index 0f36eda8c..dcc45b66e 100644 --- a/contrib/fourier/Fourier_util.v +++ b/contrib/fourier/Fourier_util.v @@ -13,229 +13,215 @@ Comments "Lemmas used by the tactic Fourier". Open Scope R_scope. -Lemma Rfourier_lt: - (x1, y1, a : R) (Rlt x1 y1) -> (Rlt R0 a) -> (Rlt (Rmult a x1) (Rmult a y1)). -Intros; Apply Rlt_monotony; Assumption. -Qed. - -Lemma Rfourier_le: - (x1, y1, a : R) (Rle x1 y1) -> (Rlt R0 a) -> (Rle (Rmult a x1) (Rmult a y1)). -Red. -Intros. -Case H; Auto with real. -Qed. - -Lemma Rfourier_lt_lt: - (x1, y1, x2, y2, a : R) - (Rlt x1 y1) -> - (Rlt x2 y2) -> - (Rlt R0 a) -> (Rlt (Rplus x1 (Rmult a x2)) (Rplus y1 (Rmult a y2))). -Intros x1 y1 x2 y2 a H H0 H1; Try Assumption. -Apply Rplus_lt. -Try Exact H. -Apply Rfourier_lt. -Try Exact H0. -Try Exact H1. -Qed. - -Lemma Rfourier_lt_le: - (x1, y1, x2, y2, a : R) - (Rlt x1 y1) -> - (Rle x2 y2) -> - (Rlt R0 a) -> (Rlt (Rplus x1 (Rmult a x2)) (Rplus y1 (Rmult a y2))). -Intros x1 y1 x2 y2 a H H0 H1; Try Assumption. -Case H0; Intros. -Apply Rplus_lt. -Try Exact H. -Apply Rfourier_lt; Auto with real. -Rewrite H2. -Rewrite (Rplus_sym y1 (Rmult a y2)). -Rewrite (Rplus_sym x1 (Rmult a y2)). -Apply Rlt_compatibility. -Try Exact H. -Qed. - -Lemma Rfourier_le_lt: - (x1, y1, x2, y2, a : R) - (Rle x1 y1) -> - (Rlt x2 y2) -> - (Rlt R0 a) -> (Rlt (Rplus x1 (Rmult a x2)) (Rplus y1 (Rmult a y2))). -Intros x1 y1 x2 y2 a H H0 H1; Try Assumption. -Case H; Intros. -Apply Rfourier_lt_le; Auto with real. -Rewrite H2. -Apply Rlt_compatibility. -Apply Rfourier_lt; Auto with real. -Qed. - -Lemma Rfourier_le_le: - (x1, y1, x2, y2, a : R) - (Rle x1 y1) -> - (Rle x2 y2) -> - (Rlt R0 a) -> (Rle (Rplus x1 (Rmult a x2)) (Rplus y1 (Rmult a y2))). -Intros x1 y1 x2 y2 a H H0 H1; Try Assumption. -Case H0; Intros. -Red. -Left; Try Assumption. -Apply Rfourier_le_lt; Auto with real. -Rewrite H2. -Case H; Intros. -Red. -Left; Try Assumption. -Rewrite (Rplus_sym x1 (Rmult a y2)). -Rewrite (Rplus_sym y1 (Rmult a y2)). -Apply Rlt_compatibility. -Try Exact H3. -Rewrite H3. -Red. -Right; Try Assumption. -Auto with real. -Qed. - -Lemma Rlt_zero_pos_plus1: (x : R) (Rlt R0 x) -> (Rlt R0 (Rplus R1 x)). -Intros x H; Try Assumption. -Rewrite Rplus_sym. -Apply Rlt_r_plus_R1. -Red; Auto with real. -Qed. - -Lemma Rlt_mult_inv_pos: - (x, y : R) (Rlt R0 x) -> (Rlt R0 y) -> (Rlt R0 (Rmult x (Rinv y))). -Intros x y H H0; Try Assumption. -Replace R0 with (Rmult x R0). -Apply Rlt_monotony; Auto with real. -Ring. -Qed. - -Lemma Rlt_zero_1: (Rlt R0 R1). -Exact Rlt_R0_R1. -Qed. - -Lemma Rle_zero_pos_plus1: (x : R) (Rle R0 x) -> (Rle R0 (Rplus R1 x)). -Intros x H; Try Assumption. -Case H; Intros. -Red. -Left; Try Assumption. -Apply Rlt_zero_pos_plus1; Auto with real. -Rewrite <- H0. -Replace (Rplus R1 R0) with R1. -Red; Left. -Exact Rlt_zero_1. -Ring. -Qed. - -Lemma Rle_mult_inv_pos: - (x, y : R) (Rle R0 x) -> (Rlt R0 y) -> (Rle R0 (Rmult x (Rinv y))). -Intros x y H H0; Try Assumption. -Case H; Intros. -Red; Left. -Apply Rlt_mult_inv_pos; Auto with real. -Rewrite <- H1. -Red; Right; Ring. -Qed. - -Lemma Rle_zero_1: (Rle R0 R1). -Red; Left. -Exact Rlt_zero_1. -Qed. - -Lemma Rle_not_lt: - (n, d : R) (Rle R0 (Rmult n (Rinv d))) -> ~ (Rlt R0 (Rmult (Ropp n) (Rinv d))). -Intros n d H; Red; Intros H0; Try Exact H0. -Generalize (Rle_not R0 (Rmult n (Rinv d))). -Intros H1; Elim H1; Try Assumption. -Replace (Rmult n (Rinv d)) with (Ropp (Ropp (Rmult n (Rinv d)))). -Replace R0 with (Ropp (Ropp R0)). -Replace (Ropp (Rmult n (Rinv d))) with (Rmult (Ropp n) (Rinv d)). -Replace (Ropp R0) with R0. -Red. -Try Exact H0. -Apply Rgt_Ropp. -Replace (Ropp (Rmult n (Rinv d))) with (Rmult (Ropp n) (Rinv d)). -Replace (Ropp R0) with R0. -Red. -Try Exact H0. -Ring. -Ring. -Ring. -Ring. -Ring. -Ring. -Qed. - -Lemma Rnot_lt0: (x : R) ~ (Rlt R0 (Rmult R0 x)). -Intros x; Try Assumption. -Replace (Rmult R0 x) with R0. -Apply Rlt_antirefl. -Ring. -Qed. - -Lemma Rlt_not_le: - (n, d : R) (Rlt R0 (Rmult n (Rinv d))) -> ~ (Rle R0 (Rmult (Ropp n) (Rinv d))). -Intros n d H; Try Assumption. -Apply Rle_not. -Replace R0 with (Ropp R0). -Replace (Rmult (Ropp n) (Rinv d)) with (Ropp (Rmult n (Rinv d))). -Apply Rlt_Ropp. -Try Exact H. -Ring. -Ring. +Lemma Rfourier_lt : forall x1 y1 a:R, x1 < y1 -> 0 < a -> a * x1 < a * y1. +intros; apply Rmult_lt_compat_l; assumption. +Qed. + +Lemma Rfourier_le : forall x1 y1 a:R, x1 <= y1 -> 0 < a -> a * x1 <= a * y1. +red in |- *. +intros. +case H; auto with real. +Qed. + +Lemma Rfourier_lt_lt : + forall x1 y1 x2 y2 a:R, + x1 < y1 -> x2 < y2 -> 0 < a -> x1 + a * x2 < y1 + a * y2. +intros x1 y1 x2 y2 a H H0 H1; try assumption. +apply Rplus_lt_compat. +try exact H. +apply Rfourier_lt. +try exact H0. +try exact H1. +Qed. + +Lemma Rfourier_lt_le : + forall x1 y1 x2 y2 a:R, + x1 < y1 -> x2 <= y2 -> 0 < a -> x1 + a * x2 < y1 + a * y2. +intros x1 y1 x2 y2 a H H0 H1; try assumption. +case H0; intros. +apply Rplus_lt_compat. +try exact H. +apply Rfourier_lt; auto with real. +rewrite H2. +rewrite (Rplus_comm y1 (a * y2)). +rewrite (Rplus_comm x1 (a * y2)). +apply Rplus_lt_compat_l. +try exact H. +Qed. + +Lemma Rfourier_le_lt : + forall x1 y1 x2 y2 a:R, + x1 <= y1 -> x2 < y2 -> 0 < a -> x1 + a * x2 < y1 + a * y2. +intros x1 y1 x2 y2 a H H0 H1; try assumption. +case H; intros. +apply Rfourier_lt_le; auto with real. +rewrite H2. +apply Rplus_lt_compat_l. +apply Rfourier_lt; auto with real. +Qed. + +Lemma Rfourier_le_le : + forall x1 y1 x2 y2 a:R, + x1 <= y1 -> x2 <= y2 -> 0 < a -> x1 + a * x2 <= y1 + a * y2. +intros x1 y1 x2 y2 a H H0 H1; try assumption. +case H0; intros. +red in |- *. +left; try assumption. +apply Rfourier_le_lt; auto with real. +rewrite H2. +case H; intros. +red in |- *. +left; try assumption. +rewrite (Rplus_comm x1 (a * y2)). +rewrite (Rplus_comm y1 (a * y2)). +apply Rplus_lt_compat_l. +try exact H3. +rewrite H3. +red in |- *. +right; try assumption. +auto with real. +Qed. + +Lemma Rlt_zero_pos_plus1 : forall x:R, 0 < x -> 0 < 1 + x. +intros x H; try assumption. +rewrite Rplus_comm. +apply Rle_lt_0_plus_1. +red in |- *; auto with real. +Qed. + +Lemma Rlt_mult_inv_pos : forall x y:R, 0 < x -> 0 < y -> 0 < x * / y. +intros x y H H0; try assumption. +replace 0 with (x * 0). +apply Rmult_lt_compat_l; auto with real. +ring. +Qed. + +Lemma Rlt_zero_1 : 0 < 1. +exact Rlt_0_1. +Qed. + +Lemma Rle_zero_pos_plus1 : forall x:R, 0 <= x -> 0 <= 1 + x. +intros x H; try assumption. +case H; intros. +red in |- *. +left; try assumption. +apply Rlt_zero_pos_plus1; auto with real. +rewrite <- H0. +replace (1 + 0) with 1. +red in |- *; left. +exact Rlt_zero_1. +ring. +Qed. + +Lemma Rle_mult_inv_pos : forall x y:R, 0 <= x -> 0 < y -> 0 <= x * / y. +intros x y H H0; try assumption. +case H; intros. +red in |- *; left. +apply Rlt_mult_inv_pos; auto with real. +rewrite <- H1. +red in |- *; right; ring. +Qed. + +Lemma Rle_zero_1 : 0 <= 1. +red in |- *; left. +exact Rlt_zero_1. +Qed. + +Lemma Rle_not_lt : forall n d:R, 0 <= n * / d -> ~ 0 < - n * / d. +intros n d H; red in |- *; intros H0; try exact H0. +generalize (Rgt_not_le 0 (n * / d)). +intros H1; elim H1; try assumption. +replace (n * / d) with (- - (n * / d)). +replace 0 with (- -0). +replace (- (n * / d)) with (- n * / d). +replace (-0) with 0. +red in |- *. +try exact H0. +apply Ropp_gt_lt_contravar. +replace (- (n * / d)) with (- n * / d). +replace (-0) with 0. +red in |- *. +try exact H0. +ring. +ring. +ring. +ring. +ring. +ring. +Qed. + +Lemma Rnot_lt0 : forall x:R, ~ 0 < 0 * x. +intros x; try assumption. +replace (0 * x) with 0. +apply Rlt_irrefl. +ring. +Qed. + +Lemma Rlt_not_le : forall n d:R, 0 < n * / d -> ~ 0 <= - n * / d. +intros n d H; try assumption. +apply Rgt_not_le. +replace 0 with (-0). +replace (- n * / d) with (- (n * / d)). +apply Ropp_lt_gt_contravar. +try exact H. +ring. +ring. +Qed. + +Lemma Rnot_lt_lt : forall x y:R, ~ 0 < y - x -> ~ x < y. +unfold not in |- *; intros. +apply H. +apply Rplus_lt_reg_r with x. +replace (x + 0) with x. +replace (x + (y - x)) with y. +try exact H0. +ring. +ring. Qed. -Lemma Rnot_lt_lt: (x, y : R) ~ (Rlt R0 (Rminus y x)) -> ~ (Rlt x y). -Unfold not; Intros. -Apply H. -Apply Rlt_anti_compatibility with x. -Replace (Rplus x R0) with x. -Replace (Rplus x (Rminus y x)) with y. -Try Exact H0. -Ring. -Ring. +Lemma Rnot_le_le : forall x y:R, ~ 0 <= y - x -> ~ x <= y. +unfold not in |- *; intros. +apply H. +case H0; intros. +left. +apply Rplus_lt_reg_r with x. +replace (x + 0) with x. +replace (x + (y - x)) with y. +try exact H1. +ring. +ring. +right. +rewrite H1; ring. Qed. -Lemma Rnot_le_le: (x, y : R) ~ (Rle R0 (Rminus y x)) -> ~ (Rle x y). -Unfold not; Intros. -Apply H. -Case H0; Intros. -Left. -Apply Rlt_anti_compatibility with x. -Replace (Rplus x R0) with x. -Replace (Rplus x (Rminus y x)) with y. -Try Exact H1. -Ring. -Ring. -Right. -Rewrite H1; Ring. +Lemma Rfourier_gt_to_lt : forall x y:R, y > x -> x < y. +unfold Rgt in |- *; intros; assumption. Qed. -Lemma Rfourier_gt_to_lt: (x, y : R) (Rgt y x) -> (Rlt x y). -Unfold Rgt; Intros; Assumption. -Qed. - -Lemma Rfourier_ge_to_le: (x, y : R) (Rge y x) -> (Rle x y). -Intros x y; Exact (Rge_le y x). -Qed. - -Lemma Rfourier_eqLR_to_le: (x, y : R) x == y -> (Rle x y). -Exact eq_Rle. +Lemma Rfourier_ge_to_le : forall x y:R, y >= x -> x <= y. +intros x y; exact (Rge_le y x). +Qed. + +Lemma Rfourier_eqLR_to_le : forall x y:R, x = y -> x <= y. +exact Req_le. Qed. -Lemma Rfourier_eqRL_to_le: (x, y : R) y == x -> (Rle x y). -Exact eq_Rle_sym. +Lemma Rfourier_eqRL_to_le : forall x y:R, y = x -> x <= y. +exact Req_le_sym. Qed. -Lemma Rfourier_not_ge_lt: (x, y : R) ((Rge x y) -> False) -> (Rlt x y). -Exact not_Rge. +Lemma Rfourier_not_ge_lt : forall x y:R, (x >= y -> False) -> x < y. +exact Rnot_ge_lt. Qed. -Lemma Rfourier_not_gt_le: (x, y : R) ((Rgt x y) -> False) -> (Rle x y). -Exact Rgt_not_le. +Lemma Rfourier_not_gt_le : forall x y:R, (x > y -> False) -> x <= y. +exact Rnot_gt_le. Qed. -Lemma Rfourier_not_le_gt: (x, y : R) ((Rle x y) -> False) -> (Rgt x y). -Exact not_Rle. +Lemma Rfourier_not_le_gt : forall x y:R, (x <= y -> False) -> x > y. +exact Rnot_le_lt. Qed. -Lemma Rfourier_not_lt_ge: (x, y : R) ((Rlt x y) -> False) -> (Rge x y). -Exact Rlt_not_ge. -Qed. +Lemma Rfourier_not_lt_ge : forall x y:R, (x < y -> False) -> x >= y. +exact Rnot_lt_ge. +Qed.
\ No newline at end of file diff --git a/contrib/omega/Omega.v b/contrib/omega/Omega.v index 480f7594b..e381b1fbe 100755 --- a/contrib/omega/Omega.v +++ b/contrib/omega/Omega.v @@ -19,9 +19,9 @@ Require Export ZArith_base. Require Export OmegaLemmas. -Hints Resolve Zle_n Zplus_sym Zplus_assoc Zmult_sym Zmult_assoc - Zero_left Zero_right Zmult_one Zplus_inverse_l Zplus_inverse_r - Zmult_plus_distr_l Zmult_plus_distr_r : zarith. +Hint Resolve Zle_refl Zplus_comm Zplus_assoc Zmult_comm Zmult_assoc Zplus_0_l + Zplus_0_r Zmult_1_l Zplus_opp_l Zplus_opp_r Zmult_plus_distr_l + Zmult_plus_distr_r: zarith. Require Export Zhints. @@ -30,28 +30,28 @@ Require Export Zhints. Require Minus. *) -Hint eq_nat_Omega : zarith := Extern 10 (eq nat ? ?) Abstract Omega. -Hint le_Omega : zarith := Extern 10 (le ? ?) Abstract Omega. -Hint lt_Omega : zarith := Extern 10 (lt ? ?) Abstract Omega. -Hint ge_Omega : zarith := Extern 10 (ge ? ?) Abstract Omega. -Hint gt_Omega : zarith := Extern 10 (gt ? ?) Abstract Omega. - -Hint not_eq_nat_Omega : zarith := Extern 10 ~(eq nat ? ?) Abstract Omega. -Hint not_le_Omega : zarith := Extern 10 ~(le ? ?) Abstract Omega. -Hint not_lt_Omega : zarith := Extern 10 ~(lt ? ?) Abstract Omega. -Hint not_ge_Omega : zarith := Extern 10 ~(ge ? ?) Abstract Omega. -Hint not_gt_Omega : zarith := Extern 10 ~(gt ? ?) Abstract Omega. - -Hint eq_Z_Omega : zarith := Extern 10 (eq Z ? ?) Abstract Omega. -Hint Zle_Omega : zarith := Extern 10 (Zle ? ?) Abstract Omega. -Hint Zlt_Omega : zarith := Extern 10 (Zlt ? ?) Abstract Omega. -Hint Zge_Omega : zarith := Extern 10 (Zge ? ?) Abstract Omega. -Hint Zgt_Omega : zarith := Extern 10 (Zgt ? ?) Abstract Omega. - -Hint not_eq_nat_Omega : zarith := Extern 10 ~(eq Z ? ?) Abstract Omega. -Hint not_Zle_Omega : zarith := Extern 10 ~(Zle ? ?) Abstract Omega. -Hint not_Zlt_Omega : zarith := Extern 10 ~(Zlt ? ?) Abstract Omega. -Hint not_Zge_Omega : zarith := Extern 10 ~(Zge ? ?) Abstract Omega. -Hint not_Zgt_Omega : zarith := Extern 10 ~(Zgt ? ?) Abstract Omega. - -Hint false_Omega : zarith := Extern 10 False Abstract Omega. +Hint Extern 10 (_ = _ :>nat) => abstract omega: zarith. +Hint Extern 10 (_ <= _) => abstract omega: zarith. +Hint Extern 10 (_ < _) => abstract omega: zarith. +Hint Extern 10 (_ >= _) => abstract omega: zarith. +Hint Extern 10 (_ > _) => abstract omega: zarith. + +Hint Extern 10 (_ <> _ :>nat) => abstract omega: zarith. +Hint Extern 10 (~ _ <= _) => abstract omega: zarith. +Hint Extern 10 (~ _ < _) => abstract omega: zarith. +Hint Extern 10 (~ _ >= _) => abstract omega: zarith. +Hint Extern 10 (~ _ > _) => abstract omega: zarith. + +Hint Extern 10 (_ = _ :>Z) => abstract omega: zarith. +Hint Extern 10 (_ <= _)%Z => abstract omega: zarith. +Hint Extern 10 (_ < _)%Z => abstract omega: zarith. +Hint Extern 10 (_ >= _)%Z => abstract omega: zarith. +Hint Extern 10 (_ > _)%Z => abstract omega: zarith. + +Hint Extern 10 (_ <> _ :>Z) => abstract omega: zarith. +Hint Extern 10 (~ (_ <= _)%Z) => abstract omega: zarith. +Hint Extern 10 (~ (_ < _)%Z) => abstract omega: zarith. +Hint Extern 10 (~ (_ >= _)%Z) => abstract omega: zarith. +Hint Extern 10 (~ (_ > _)%Z) => abstract omega: zarith. + +Hint Extern 10 False => abstract omega: zarith.
\ No newline at end of file diff --git a/contrib/omega/OmegaLemmas.v b/contrib/omega/OmegaLemmas.v index c29224069..61747028e 100644 --- a/contrib/omega/OmegaLemmas.v +++ b/contrib/omega/OmegaLemmas.v @@ -8,392 +8,262 @@ (*i $Id$ i*) -Require ZArith_base. +Require Import ZArith_base. (** These are specific variants of theorems dedicated for the Omega tactic *) -Lemma new_var: (x:Z) (EX y:Z |(x=y)). -Intros x; Exists x; Trivial with arith. +Lemma new_var : forall x:Z, exists y : Z | x = y. +intros x; exists x; trivial with arith. Qed. -Lemma OMEGA1 : (x,y:Z) (x=y) -> (Zle ZERO x) -> (Zle ZERO y). -Intros x y H; Rewrite H; Auto with arith. +Lemma OMEGA1 : forall x y:Z, x = y -> (0 <= x)%Z -> (0 <= y)%Z. +intros x y H; rewrite H; auto with arith. Qed. -Lemma OMEGA2 : (x,y:Z) (Zle ZERO x) -> (Zle ZERO y) -> (Zle ZERO (Zplus x y)). -Exact Zle_0_plus. +Lemma OMEGA2 : forall x y:Z, (0 <= x)%Z -> (0 <= y)%Z -> (0 <= x + y)%Z. +exact Zplus_le_0_compat. Qed. -Lemma OMEGA3 : - (x,y,k:Z)(Zgt k ZERO)-> (x=(Zmult y k)) -> (x=ZERO) -> (y=ZERO). +Lemma OMEGA3 : + forall x y k:Z, (k > 0)%Z -> x = (y * k)%Z -> x = 0%Z -> y = 0%Z. -Intros x y k H1 H2 H3; Apply (Zmult_eq k); [ - Unfold not ; Intros H4; Absurd (Zgt k ZERO); [ - Rewrite H4; Unfold Zgt ; Simpl; Discriminate | Assumption] - | Rewrite <- H2; Assumption]. +intros x y k H1 H2 H3; apply (Zmult_integral_l k); + [ unfold not in |- *; intros H4; absurd (k > 0)%Z; + [ rewrite H4; unfold Zgt in |- *; simpl in |- *; discriminate + | assumption ] + | rewrite <- H2; assumption ]. Qed. -Lemma OMEGA4 : - (x,y,z:Z)(Zgt x ZERO) -> (Zgt y x) -> ~(Zplus (Zmult z y) x) = ZERO. - -Unfold not ; Intros x y z H1 H2 H3; Cut (Zgt y ZERO); [ - Intros H4; Cut (Zle ZERO (Zplus (Zmult z y) x)); [ - Intros H5; Generalize (Zmult_le_approx y z x H4 H2 H5) ; Intros H6; - Absurd (Zgt (Zplus (Zmult z y) x) ZERO); [ - Rewrite -> H3; Unfold Zgt ; Simpl; Discriminate - | Apply Zle_gt_trans with x ; [ - Pattern 1 x ; Rewrite <- (Zero_left x); Apply Zle_reg_r; - Rewrite -> Zmult_sym; Generalize H4 ; Unfold Zgt; - Case y; [ - Simpl; Intros H7; Discriminate H7 - | Intros p H7; Rewrite <- (Zero_mult_right (POS p)); - Unfold Zle ; Rewrite -> Zcompare_Zmult_compatible; Exact H6 - | Simpl; Intros p H7; Discriminate H7] - | Assumption]] - | Rewrite -> H3; Unfold Zle ; Simpl; Discriminate] - | Apply Zgt_trans with x ; [ Assumption | Assumption]]. +Lemma OMEGA4 : forall x y z:Z, (x > 0)%Z -> (y > x)%Z -> (z * y + x)%Z <> 0%Z. + +unfold not in |- *; intros x y z H1 H2 H3; cut (y > 0)%Z; + [ intros H4; cut (0 <= z * y + x)%Z; + [ intros H5; generalize (Zmult_le_approx y z x H4 H2 H5); intros H6; + absurd (z * y + x > 0)%Z; + [ rewrite H3; unfold Zgt in |- *; simpl in |- *; discriminate + | apply Zle_gt_trans with x; + [ pattern x at 1 in |- *; rewrite <- (Zplus_0_l x); + apply Zplus_le_compat_r; rewrite Zmult_comm; + generalize H4; unfold Zgt in |- *; case y; + [ simpl in |- *; intros H7; discriminate H7 + | intros p H7; rewrite <- (Zmult_0_r (Zpos p)); + unfold Zle in |- *; rewrite Zcompare_mult_compat; + exact H6 + | simpl in |- *; intros p H7; discriminate H7 ] + | assumption ] ] + | rewrite H3; unfold Zle in |- *; simpl in |- *; discriminate ] + | apply Zgt_trans with x; [ assumption | assumption ] ]. Qed. -Lemma OMEGA5: (x,y,z:Z)(x=ZERO) -> (y=ZERO) -> (Zplus x (Zmult y z)) = ZERO. +Lemma OMEGA5 : forall x y z:Z, x = 0%Z -> y = 0%Z -> (x + y * z)%Z = 0%Z. -Intros x y z H1 H2; Rewrite H1; Rewrite H2; Simpl; Trivial with arith. +intros x y z H1 H2; rewrite H1; rewrite H2; simpl in |- *; trivial with arith. Qed. -Lemma OMEGA6: - (x,y,z:Z)(Zle ZERO x) -> (y=ZERO) -> (Zle ZERO (Zplus x (Zmult y z))). +Lemma OMEGA6 : forall x y z:Z, (0 <= x)%Z -> y = 0%Z -> (0 <= x + y * z)%Z. -Intros x y z H1 H2; Rewrite H2; Simpl; Rewrite Zero_right; Assumption. +intros x y z H1 H2; rewrite H2; simpl in |- *; rewrite Zplus_0_r; assumption. Qed. -Lemma OMEGA7: - (x,y,z,t:Z)(Zgt z ZERO) -> (Zgt t ZERO) -> (Zle ZERO x) -> (Zle ZERO y) -> - (Zle ZERO (Zplus (Zmult x z) (Zmult y t))). +Lemma OMEGA7 : + forall x y z t:Z, + (z > 0)%Z -> + (t > 0)%Z -> (0 <= x)%Z -> (0 <= y)%Z -> (0 <= x * z + y * t)%Z. -Intros x y z t H1 H2 H3 H4; Rewrite <- (Zero_left ZERO); -Apply Zle_plus_plus; Apply Zle_mult; Assumption. +intros x y z t H1 H2 H3 H4; rewrite <- (Zplus_0_l 0); apply Zplus_le_compat; + apply Zmult_gt_0_le_0_compat; assumption. Qed. -Lemma OMEGA8: - (x,y:Z) (Zle ZERO x) -> (Zle ZERO y) -> x = (Zopp y) -> x = ZERO. +Lemma OMEGA8 : + forall x y:Z, (0 <= x)%Z -> (0 <= y)%Z -> x = (- y)%Z -> x = 0%Z. -Intros x y H1 H2 H3; Elim (Zle_lt_or_eq ZERO x H1); [ - Intros H4; Absurd (Zlt ZERO x); [ - Change (Zge ZERO x); Apply Zle_ge; Apply Zsimpl_le_plus_l with y; - Rewrite -> H3; Rewrite Zplus_inverse_r; Rewrite Zero_right; Assumption - | Assumption] -| Intros H4; Rewrite -> H4; Trivial with arith]. +intros x y H1 H2 H3; elim (Zle_lt_or_eq 0 x H1); + [ intros H4; absurd (0 < x)%Z; + [ change (0 >= x)%Z in |- *; apply Zle_ge; apply Zplus_le_reg_l with y; + rewrite H3; rewrite Zplus_opp_r; rewrite Zplus_0_r; + assumption + | assumption ] + | intros H4; rewrite H4; trivial with arith ]. Qed. -Lemma OMEGA9:(x,y,z,t:Z) y=ZERO -> x = z -> - (Zplus y (Zmult (Zplus (Zopp x) z) t)) = ZERO. +Lemma OMEGA9 : + forall x y z t:Z, y = 0%Z -> x = z -> (y + (- x + z) * t)%Z = 0%Z. -Intros x y z t H1 H2; Rewrite H2; Rewrite Zplus_inverse_l; -Rewrite Zero_mult_left; Rewrite Zero_right; Assumption. +intros x y z t H1 H2; rewrite H2; rewrite Zplus_opp_l; rewrite Zmult_0_l; + rewrite Zplus_0_r; assumption. Qed. -Lemma OMEGA10:(v,c1,c2,l1,l2,k1,k2:Z) - (Zplus (Zmult (Zplus (Zmult v c1) l1) k1) (Zmult (Zplus (Zmult v c2) l2) k2)) - = (Zplus (Zmult v (Zplus (Zmult c1 k1) (Zmult c2 k2))) - (Zplus (Zmult l1 k1) (Zmult l2 k2))). +Lemma OMEGA10 : + forall v c1 c2 l1 l2 k1 k2:Z, + ((v * c1 + l1) * k1 + (v * c2 + l2) * k2)%Z = + (v * (c1 * k1 + c2 * k2) + (l1 * k1 + l2 * k2))%Z. -Intros; Repeat (Rewrite Zmult_plus_distr_l Orelse Rewrite Zmult_plus_distr_r); -Repeat Rewrite Zmult_assoc; Repeat Elim Zplus_assoc; -Rewrite (Zplus_permute (Zmult l1 k1) (Zmult (Zmult v c2) k2)); Trivial with arith. +intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r; + repeat rewrite Zmult_assoc; repeat elim Zplus_assoc; + rewrite (Zplus_permute (l1 * k1) (v * c2 * k2)); trivial with arith. Qed. -Lemma OMEGA11:(v1,c1,l1,l2,k1:Z) - (Zplus (Zmult (Zplus (Zmult v1 c1) l1) k1) l2) - = (Zplus (Zmult v1 (Zmult c1 k1)) (Zplus (Zmult l1 k1) l2)). +Lemma OMEGA11 : + forall v1 c1 l1 l2 k1:Z, + ((v1 * c1 + l1) * k1 + l2)%Z = (v1 * (c1 * k1) + (l1 * k1 + l2))%Z. -Intros; Repeat (Rewrite Zmult_plus_distr_l Orelse Rewrite Zmult_plus_distr_r); -Repeat Rewrite Zmult_assoc; Repeat Elim Zplus_assoc; Trivial with arith. +intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r; + repeat rewrite Zmult_assoc; repeat elim Zplus_assoc; + trivial with arith. Qed. -Lemma OMEGA12:(v2,c2,l1,l2,k2:Z) - (Zplus l1 (Zmult (Zplus (Zmult v2 c2) l2) k2)) - = (Zplus (Zmult v2 (Zmult c2 k2)) (Zplus l1 (Zmult l2 k2))). +Lemma OMEGA12 : + forall v2 c2 l1 l2 k2:Z, + (l1 + (v2 * c2 + l2) * k2)%Z = (v2 * (c2 * k2) + (l1 + l2 * k2))%Z. -Intros; Repeat (Rewrite Zmult_plus_distr_l Orelse Rewrite Zmult_plus_distr_r); -Repeat Rewrite Zmult_assoc; Repeat Elim Zplus_assoc; Rewrite Zplus_permute; -Trivial with arith. +intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r; + repeat rewrite Zmult_assoc; repeat elim Zplus_assoc; + rewrite Zplus_permute; trivial with arith. Qed. -Lemma OMEGA13:(v,l1,l2:Z)(x:positive) - (Zplus (Zplus (Zmult v (POS x)) l1) (Zplus (Zmult v (NEG x)) l2)) - = (Zplus l1 l2). +Lemma OMEGA13 : + forall (v l1 l2:Z) (x:positive), + (v * Zpos x + l1 + (v * Zneg x + l2))%Z = (l1 + l2)%Z. -Intros; Rewrite Zplus_assoc; Rewrite (Zplus_sym (Zmult v (POS x)) l1); -Rewrite (Zplus_assoc_r l1); Rewrite <- Zmult_plus_distr_r; -Rewrite <- Zopp_NEG; Rewrite (Zplus_sym (Zopp (NEG x)) (NEG x)); -Rewrite Zplus_inverse_r; Rewrite Zero_mult_right; Rewrite Zero_right; Trivial with arith. +intros; rewrite Zplus_assoc; rewrite (Zplus_comm (v * Zpos x) l1); + rewrite (Zplus_assoc_reverse l1); rewrite <- Zmult_plus_distr_r; + rewrite <- Zopp_neg; rewrite (Zplus_comm (- Zneg x) (Zneg x)); + rewrite Zplus_opp_r; rewrite Zmult_0_r; rewrite Zplus_0_r; + trivial with arith. Qed. -Lemma OMEGA14:(v,l1,l2:Z)(x:positive) - (Zplus (Zplus (Zmult v (NEG x)) l1) (Zplus (Zmult v (POS x)) l2)) - = (Zplus l1 l2). - -Intros; Rewrite Zplus_assoc; Rewrite (Zplus_sym (Zmult v (NEG x)) l1); -Rewrite (Zplus_assoc_r l1); Rewrite <- Zmult_plus_distr_r; -Rewrite <- Zopp_NEG; Rewrite Zplus_inverse_r; Rewrite Zero_mult_right; -Rewrite Zero_right; Trivial with arith. +Lemma OMEGA14 : + forall (v l1 l2:Z) (x:positive), + (v * Zneg x + l1 + (v * Zpos x + l2))%Z = (l1 + l2)%Z. + +intros; rewrite Zplus_assoc; rewrite (Zplus_comm (v * Zneg x) l1); + rewrite (Zplus_assoc_reverse l1); rewrite <- Zmult_plus_distr_r; + rewrite <- Zopp_neg; rewrite Zplus_opp_r; rewrite Zmult_0_r; + rewrite Zplus_0_r; trivial with arith. Qed. -Lemma OMEGA15:(v,c1,c2,l1,l2,k2:Z) - (Zplus (Zplus (Zmult v c1) l1) (Zmult (Zplus (Zmult v c2) l2) k2)) - = (Zplus (Zmult v (Zplus c1 (Zmult c2 k2))) - (Zplus l1 (Zmult l2 k2))). - -Intros; Repeat (Rewrite Zmult_plus_distr_l Orelse Rewrite Zmult_plus_distr_r); -Repeat Rewrite Zmult_assoc; Repeat Elim Zplus_assoc; -Rewrite (Zplus_permute l1 (Zmult (Zmult v c2) k2)); Trivial with arith. +Lemma OMEGA15 : + forall v c1 c2 l1 l2 k2:Z, + (v * c1 + l1 + (v * c2 + l2) * k2)%Z = + (v * (c1 + c2 * k2) + (l1 + l2 * k2))%Z. + +intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r; + repeat rewrite Zmult_assoc; repeat elim Zplus_assoc; + rewrite (Zplus_permute l1 (v * c2 * k2)); trivial with arith. Qed. -Lemma OMEGA16: - (v,c,l,k:Z) - (Zmult (Zplus (Zmult v c) l) k) = (Zplus (Zmult v (Zmult c k)) (Zmult l k)). +Lemma OMEGA16 : + forall v c l k:Z, ((v * c + l) * k)%Z = (v * (c * k) + l * k)%Z. -Intros; Repeat (Rewrite Zmult_plus_distr_l Orelse Rewrite Zmult_plus_distr_r); -Repeat Rewrite Zmult_assoc; Repeat Elim Zplus_assoc; Trivial with arith. +intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r; + repeat rewrite Zmult_assoc; repeat elim Zplus_assoc; + trivial with arith. Qed. -Lemma OMEGA17: - (x,y,z:Z)(Zne x ZERO) -> (y=ZERO) -> (Zne (Zplus x (Zmult y z)) ZERO). +Lemma OMEGA17 : forall x y z:Z, Zne x 0 -> y = 0%Z -> Zne (x + y * z) 0. -Unfold Zne not; Intros x y z H1 H2 H3; Apply H1; -Apply Zsimpl_plus_l with (Zmult y z); Rewrite Zplus_sym; Rewrite H3; -Rewrite H2; Auto with arith. +unfold Zne, not in |- *; intros x y z H1 H2 H3; apply H1; + apply Zplus_reg_l with (y * z)%Z; rewrite Zplus_comm; + rewrite H3; rewrite H2; auto with arith. Qed. -Lemma OMEGA18: - (x,y,k:Z) x=(Zmult y k) -> (Zne x ZERO) -> (Zne y ZERO). +Lemma OMEGA18 : forall x y k:Z, x = (y * k)%Z -> Zne x 0 -> Zne y 0. -Unfold Zne not; Intros x y k H1 H2 H3; Apply H2; Rewrite H1; Rewrite H3; Auto with arith. +unfold Zne, not in |- *; intros x y k H1 H2 H3; apply H2; rewrite H1; + rewrite H3; auto with arith. Qed. -Lemma OMEGA19: - (x:Z) (Zne x ZERO) -> - (Zle ZERO (Zplus x (NEG xH))) \/ (Zle ZERO (Zplus (Zmult x (NEG xH)) (NEG xH))). - -Unfold Zne ; Intros x H; Elim (Zle_or_lt ZERO x); [ - Intros H1; Elim Zle_lt_or_eq with 1:=H1; [ - Intros H2; Left; Change (Zle ZERO (Zpred x)); Apply Zle_S_n; - Rewrite <- Zs_pred; Apply Zlt_le_S; Assumption - | Intros H2; Absurd x=ZERO; Auto with arith] -| Intros H1; Right; Rewrite <- Zopp_one; Rewrite Zplus_sym; - Apply Zle_left; Apply Zle_S_n; Simpl; Apply Zlt_le_S; Auto with arith]. +Lemma OMEGA19 : + forall x:Z, Zne x 0 -> (0 <= x + -1)%Z \/ (0 <= x * -1 + -1)%Z. + +unfold Zne in |- *; intros x H; elim (Zle_or_lt 0 x); + [ intros H1; elim Zle_lt_or_eq with (1 := H1); + [ intros H2; left; change (0 <= Zpred x)%Z in |- *; apply Zsucc_le_reg; + rewrite <- Zsucc_pred; apply Zlt_le_succ; assumption + | intros H2; absurd (x = 0%Z); auto with arith ] + | intros H1; right; rewrite <- Zopp_eq_mult_neg_1; rewrite Zplus_comm; + apply Zle_left; apply Zsucc_le_reg; simpl in |- *; + apply Zlt_le_succ; auto with arith ]. Qed. -Lemma OMEGA20: - (x,y,z:Z)(Zne x ZERO) -> (y=ZERO) -> (Zne (Zplus x (Zmult y z)) ZERO). +Lemma OMEGA20 : forall x y z:Z, Zne x 0 -> y = 0%Z -> Zne (x + y * z) 0. -Unfold Zne not; Intros x y z H1 H2 H3; Apply H1; Rewrite H2 in H3; -Simpl in H3; Rewrite Zero_right in H3; Trivial with arith. +unfold Zne, not in |- *; intros x y z H1 H2 H3; apply H1; rewrite H2 in H3; + simpl in H3; rewrite Zplus_0_r in H3; trivial with arith. Qed. -Definition fast_Zplus_sym := -[x,y:Z][P:Z -> Prop][H: (P (Zplus y x))] - (eq_ind_r Z (Zplus y x) P H (Zplus x y) (Zplus_sym x y)). - -Definition fast_Zplus_assoc_r := -[n,m,p:Z][P:Z -> Prop][H : (P (Zplus n (Zplus m p)))] - (eq_ind_r Z (Zplus n (Zplus m p)) P H (Zplus (Zplus n m) p) (Zplus_assoc_r n m p)). - -Definition fast_Zplus_assoc_l := -[n,m,p:Z][P:Z -> Prop][H : (P (Zplus (Zplus n m) p))] - (eq_ind_r Z (Zplus (Zplus n m) p) P H (Zplus n (Zplus m p)) - (Zplus_assoc_l n m p)). - -Definition fast_Zplus_permute := -[n,m,p:Z][P:Z -> Prop][H : (P (Zplus m (Zplus n p)))] - (eq_ind_r Z (Zplus m (Zplus n p)) P H (Zplus n (Zplus m p)) - (Zplus_permute n m p)). - -Definition fast_OMEGA10 := -[v,c1,c2,l1,l2,k1,k2:Z][P:Z -> Prop] -[H : (P (Zplus (Zmult v (Zplus (Zmult c1 k1) (Zmult c2 k2))) - (Zplus (Zmult l1 k1) (Zmult l2 k2))))] - (eq_ind_r Z - (Zplus (Zmult v (Zplus (Zmult c1 k1) (Zmult c2 k2))) - (Zplus (Zmult l1 k1) (Zmult l2 k2))) - P H - (Zplus (Zmult (Zplus (Zmult v c1) l1) k1) - (Zmult (Zplus (Zmult v c2) l2) k2)) - (OMEGA10 v c1 c2 l1 l2 k1 k2)). - -Definition fast_OMEGA11 := -[v1,c1,l1,l2,k1:Z][P:Z -> Prop] -[H : (P (Zplus (Zmult v1 (Zmult c1 k1)) (Zplus (Zmult l1 k1) l2)))] - (eq_ind_r Z - (Zplus (Zmult v1 (Zmult c1 k1)) (Zplus (Zmult l1 k1) l2)) - P H - (Zplus (Zmult (Zplus (Zmult v1 c1) l1) k1) l2) - (OMEGA11 v1 c1 l1 l2 k1)). -Definition fast_OMEGA12 := -[v2,c2,l1,l2,k2:Z][P:Z -> Prop] -[H : (P (Zplus (Zmult v2 (Zmult c2 k2)) (Zplus l1 (Zmult l2 k2))))] - (eq_ind_r Z - (Zplus (Zmult v2 (Zmult c2 k2)) (Zplus l1 (Zmult l2 k2))) - P H - (Zplus l1 (Zmult (Zplus (Zmult v2 c2) l2) k2)) - (OMEGA12 v2 c2 l1 l2 k2)). - -Definition fast_OMEGA15 := -[v,c1,c2,l1,l2,k2 :Z][P:Z -> Prop] -[H : (P (Zplus (Zmult v (Zplus c1 (Zmult c2 k2))) (Zplus l1 (Zmult l2 k2))))] - (eq_ind_r Z - (Zplus (Zmult v (Zplus c1 (Zmult c2 k2))) (Zplus l1 (Zmult l2 k2))) - P H - (Zplus (Zplus (Zmult v c1) l1) (Zmult (Zplus (Zmult v c2) l2) k2)) - (OMEGA15 v c1 c2 l1 l2 k2)). -Definition fast_OMEGA16 := -[v,c,l,k :Z][P:Z -> Prop] -[H : (P (Zplus (Zmult v (Zmult c k)) (Zmult l k)))] - (eq_ind_r Z - (Zplus (Zmult v (Zmult c k)) (Zmult l k)) - P H - (Zmult (Zplus (Zmult v c) l) k) - (OMEGA16 v c l k)). - -Definition fast_OMEGA13 := -[v,l1,l2 :Z][x:positive][P:Z -> Prop] -[H : (P (Zplus l1 l2))] - (eq_ind_r Z - (Zplus l1 l2) - P H - (Zplus (Zplus (Zmult v (POS x)) l1) (Zplus (Zmult v (NEG x)) l2)) - (OMEGA13 v l1 l2 x )). - -Definition fast_OMEGA14 := -[v,l1,l2 :Z][x:positive][P:Z -> Prop] -[H : (P (Zplus l1 l2))] - (eq_ind_r Z - (Zplus l1 l2) - P H - (Zplus (Zplus (Zmult v (NEG x)) l1) (Zplus (Zmult v (POS x)) l2)) - (OMEGA14 v l1 l2 x )). -Definition fast_Zred_factor0:= -[x:Z][P:Z -> Prop] -[H : (P (Zmult x (POS xH)) )] - (eq_ind_r Z - (Zmult x (POS xH)) - P H - x - (Zred_factor0 x)). - -Definition fast_Zopp_one := -[x:Z][P:Z -> Prop] -[H : (P (Zmult x (NEG xH)))] - (eq_ind_r Z - (Zmult x (NEG xH)) - P H - (Zopp x) - (Zopp_one x)). - -Definition fast_Zmult_sym := -[x,y :Z][P:Z -> Prop] -[H : (P (Zmult y x))] - (eq_ind_r Z -(Zmult y x) - P H -(Zmult x y) - (Zmult_sym x y )). - -Definition fast_Zopp_Zplus := -[x,y :Z][P:Z -> Prop] -[H : (P (Zplus (Zopp x) (Zopp y)) )] - (eq_ind_r Z - (Zplus (Zopp x) (Zopp y)) - P H - (Zopp (Zplus x y)) - (Zopp_Zplus x y )). - -Definition fast_Zopp_Zopp := -[x:Z][P:Z -> Prop] -[H : (P x )] (eq_ind_r Z x P H (Zopp (Zopp x)) (Zopp_Zopp x)). - -Definition fast_Zopp_Zmult_r := -[x,y:Z][P:Z -> Prop] -[H : (P (Zmult x (Zopp y)))] - (eq_ind_r Z - (Zmult x (Zopp y)) - P H - (Zopp (Zmult x y)) - (Zopp_Zmult_r x y )). - -Definition fast_Zmult_plus_distr := -[n,m,p:Z][P:Z -> Prop] -[H : (P (Zplus (Zmult n p) (Zmult m p)))] - (eq_ind_r Z - (Zplus (Zmult n p) (Zmult m p)) - P H - (Zmult (Zplus n m) p) - (Zmult_plus_distr_l n m p)). -Definition fast_Zmult_Zopp_left:= -[x,y:Z][P:Z -> Prop] -[H : (P (Zmult x (Zopp y)))] - (eq_ind_r Z - (Zmult x (Zopp y)) - P H - (Zmult (Zopp x) y) - (Zmult_Zopp_left x y)). - -Definition fast_Zmult_assoc_r := -[n,m,p :Z][P:Z -> Prop] -[H : (P (Zmult n (Zmult m p)))] - (eq_ind_r Z - (Zmult n (Zmult m p)) - P H - (Zmult (Zmult n m) p) - (Zmult_assoc_r n m p)). - -Definition fast_Zred_factor1 := -[x:Z][P:Z -> Prop] -[H : (P (Zmult x (POS (xO xH))) )] - (eq_ind_r Z - (Zmult x (POS (xO xH))) - P H - (Zplus x x) - (Zred_factor1 x)). - -Definition fast_Zred_factor2 := -[x,y:Z][P:Z -> Prop] -[H : (P (Zmult x (Zplus (POS xH) y)))] - (eq_ind_r Z - (Zmult x (Zplus (POS xH) y)) - P H - (Zplus x (Zmult x y)) - (Zred_factor2 x y)). -Definition fast_Zred_factor3 := -[x,y:Z][P:Z -> Prop] -[H : (P (Zmult x (Zplus (POS xH) y)))] - (eq_ind_r Z - (Zmult x (Zplus (POS xH) y)) - P H - (Zplus (Zmult x y) x) - (Zred_factor3 x y)). - -Definition fast_Zred_factor4 := -[x,y,z:Z][P:Z -> Prop] -[H : (P (Zmult x (Zplus y z)))] - (eq_ind_r Z - (Zmult x (Zplus y z)) - P H - (Zplus (Zmult x y) (Zmult x z)) - (Zred_factor4 x y z)). - -Definition fast_Zred_factor5 := -[x,y:Z][P:Z -> Prop] -[H : (P y)] - (eq_ind_r Z - y - P H - (Zplus (Zmult x ZERO) y) - (Zred_factor5 x y)). - -Definition fast_Zred_factor6 := -[x :Z][P:Z -> Prop] -[H : (P(Zplus x ZERO) )] - (eq_ind_r Z - (Zplus x ZERO) - P H - x - (Zred_factor6 x )). +Definition fast_Zplus_sym (x y:Z) (P:Z -> Prop) (H:P (y + x)%Z) := + eq_ind_r P H (Zplus_comm x y). + +Definition fast_Zplus_assoc_r (n m p:Z) (P:Z -> Prop) + (H:P (n + (m + p))%Z) := eq_ind_r P H (Zplus_assoc_reverse n m p). + +Definition fast_Zplus_assoc_l (n m p:Z) (P:Z -> Prop) + (H:P (n + m + p)%Z) := eq_ind_r P H (Zplus_assoc n m p). + +Definition fast_Zplus_permute (n m p:Z) (P:Z -> Prop) + (H:P (m + (n + p))%Z) := eq_ind_r P H (Zplus_permute n m p). + +Definition fast_OMEGA10 (v c1 c2 l1 l2 k1 k2:Z) (P:Z -> Prop) + (H:P (v * (c1 * k1 + c2 * k2) + (l1 * k1 + l2 * k2))%Z) := + eq_ind_r P H (OMEGA10 v c1 c2 l1 l2 k1 k2). + +Definition fast_OMEGA11 (v1 c1 l1 l2 k1:Z) (P:Z -> Prop) + (H:P (v1 * (c1 * k1) + (l1 * k1 + l2))%Z) := + eq_ind_r P H (OMEGA11 v1 c1 l1 l2 k1). +Definition fast_OMEGA12 (v2 c2 l1 l2 k2:Z) (P:Z -> Prop) + (H:P (v2 * (c2 * k2) + (l1 + l2 * k2))%Z) := + eq_ind_r P H (OMEGA12 v2 c2 l1 l2 k2). + +Definition fast_OMEGA15 (v c1 c2 l1 l2 k2:Z) (P:Z -> Prop) + (H:P (v * (c1 + c2 * k2) + (l1 + l2 * k2))%Z) := + eq_ind_r P H (OMEGA15 v c1 c2 l1 l2 k2). +Definition fast_OMEGA16 (v c l k:Z) (P:Z -> Prop) + (H:P (v * (c * k) + l * k)%Z) := eq_ind_r P H (OMEGA16 v c l k). + +Definition fast_OMEGA13 (v l1 l2:Z) (x:positive) (P:Z -> Prop) + (H:P (l1 + l2)%Z) := eq_ind_r P H (OMEGA13 v l1 l2 x). + +Definition fast_OMEGA14 (v l1 l2:Z) (x:positive) (P:Z -> Prop) + (H:P (l1 + l2)%Z) := eq_ind_r P H (OMEGA14 v l1 l2 x). +Definition fast_Zred_factor0 (x:Z) (P:Z -> Prop) (H:P (x * 1)%Z) := + eq_ind_r P H (Zred_factor0 x). + +Definition fast_Zopp_one (x:Z) (P:Z -> Prop) (H:P (x * -1)%Z) := + eq_ind_r P H (Zopp_eq_mult_neg_1 x). + +Definition fast_Zmult_sym (x y:Z) (P:Z -> Prop) (H:P (y * x)%Z) := + eq_ind_r P H (Zmult_comm x y). + +Definition fast_Zopp_Zplus (x y:Z) (P:Z -> Prop) (H:P (- x + - y)%Z) := + eq_ind_r P H (Zopp_plus_distr x y). + +Definition fast_Zopp_Zopp (x:Z) (P:Z -> Prop) (H:P x) := + eq_ind_r P H (Zopp_involutive x). + +Definition fast_Zopp_Zmult_r (x y:Z) (P:Z -> Prop) + (H:P (x * - y)%Z) := eq_ind_r P H (Zopp_mult_distr_r x y). + +Definition fast_Zmult_plus_distr (n m p:Z) (P:Z -> Prop) + (H:P (n * p + m * p)%Z) := eq_ind_r P H (Zmult_plus_distr_l n m p). +Definition fast_Zmult_Zopp_left (x y:Z) (P:Z -> Prop) + (H:P (x * - y)%Z) := eq_ind_r P H (Zmult_opp_comm x y). + +Definition fast_Zmult_assoc_r (n m p:Z) (P:Z -> Prop) + (H:P (n * (m * p))%Z) := eq_ind_r P H (Zmult_assoc_reverse n m p). + +Definition fast_Zred_factor1 (x:Z) (P:Z -> Prop) (H:P (x * 2)%Z) := + eq_ind_r P H (Zred_factor1 x). + +Definition fast_Zred_factor2 (x y:Z) (P:Z -> Prop) + (H:P (x * (1 + y))%Z) := eq_ind_r P H (Zred_factor2 x y). +Definition fast_Zred_factor3 (x y:Z) (P:Z -> Prop) + (H:P (x * (1 + y))%Z) := eq_ind_r P H (Zred_factor3 x y). + +Definition fast_Zred_factor4 (x y z:Z) (P:Z -> Prop) + (H:P (x * (y + z))%Z) := eq_ind_r P H (Zred_factor4 x y z). + +Definition fast_Zred_factor5 (x y:Z) (P:Z -> Prop) + (H:P y) := eq_ind_r P H (Zred_factor5 x y). + +Definition fast_Zred_factor6 (x:Z) (P:Z -> Prop) (H:P (x + 0)%Z) := + eq_ind_r P H (Zred_factor6 x).
\ No newline at end of file diff --git a/contrib/ring/ArithRing.v b/contrib/ring/ArithRing.v index 0a49ecb47..6c600e797 100644 --- a/contrib/ring/ArithRing.v +++ b/contrib/ring/ArithRing.v @@ -12,70 +12,78 @@ Require Export Ring. Require Export Arith. -Require Eqdep_dec. +Require Import Eqdep_dec. -V7only [Import nat_scope.]. Open Local Scope nat_scope. -Fixpoint nateq [n,m:nat] : bool := - Cases n m of - | O O => true - | (S n') (S m') => (nateq n' m') - | _ _ => false +Fixpoint nateq (n m:nat) {struct m} : bool := + match n, m with + | O, O => true + | S n', S m' => nateq n' m' + | _, _ => false end. -Lemma nateq_prop : (n,m:nat)(Is_true (nateq n m))->n==m. +Lemma nateq_prop : forall n m:nat, Is_true (nateq n m) -> n = m. Proof. - Induction n; Induction m; Intros; Try Contradiction. - Trivial. - Unfold Is_true in H1. - Rewrite (H n1 H1). - Trivial. -Save. + simple induction n; simple induction m; intros; try contradiction. + trivial. + unfold Is_true in H1. + rewrite (H n1 H1). + trivial. +Qed. -Hints Resolve nateq_prop eq2eqT : arithring. +Hint Resolve nateq_prop eq2eqT: arithring. -Definition NatTheory : (Semi_Ring_Theory plus mult (1) (0) nateq). - Split; Intros; Auto with arith arithring. - Apply eq2eqT; Apply simpl_plus_l with n:=n. - Apply eqT2eq; Trivial. +Definition NatTheory : Semi_Ring_Theory plus mult 1 0 nateq. + split; intros; auto with arith arithring. + apply eq2eqT; apply (fun n m p:nat => plus_reg_l m p n) with (n := n). + apply eqT2eq; trivial. Defined. -Add Semi Ring nat plus mult (1) (0) nateq NatTheory [O S]. +Add Semi Ring nat plus mult 1 0 nateq NatTheory [ 0 S ]. -Goal (n:nat)(S n)=(plus (S O) n). -Intro; Reflexivity. +Goal forall n:nat, S n = 1 + n. +intro; reflexivity. Save S_to_plus_one. (* Replace all occurrences of (S exp) by (plus (S O) exp), except when exp is already O and only for those occurrences than can be reached by going down plus and mult operations *) -Recursive Meta Definition S_to_plus t := - Match t With - | [(S O)] -> '(S O) - | [(S ?1)] -> Let t1 = (S_to_plus ?1) In - '(plus (S O) t1) - | [(plus ?1 ?2)] -> Let t1 = (S_to_plus ?1) - And t2 = (S_to_plus ?2) In - '(plus t1 t2) - | [(mult ?1 ?2)] -> Let t1 = (S_to_plus ?1) - And t2 = (S_to_plus ?2) In - '(mult t1 t2) - | [?] -> 't. +Ltac rewrite_S_to_plus_term t := + match constr:t with + | 1 => constr:1 + | (S ?X1) => + let t1 := rewrite_S_to_plus_term X1 in + constr:(1 + t1) + | (?X1 + ?X2) => + let t1 := rewrite_S_to_plus_term X1 + with t2 := rewrite_S_to_plus_term X2 in + constr:(t1 + t2) + | (?X1 * ?X2) => + let t1 := rewrite_S_to_plus_term X1 + with t2 := rewrite_S_to_plus_term X2 in + constr:(t1 * t2) + | _ => constr:t + end. (* Apply S_to_plus on both sides of an equality *) -Tactic Definition S_to_plus_eq := - Match Context With - | [ |- ?1 = ?2 ] -> - (**) Try (**) - Let t1 = (S_to_plus ?1) - And t2 = (S_to_plus ?2) In - Change t1=t2 - | [ |- ?1 == ?2 ] -> - (**) Try (**) - Let t1 = (S_to_plus ?1) - And t2 = (S_to_plus ?2) In - Change (t1==t2). +Ltac rewrite_S_to_plus := + match goal with + | |- (?X1 = ?X2) => + try + let t1 := + (**) (**) + rewrite_S_to_plus_term X1 + with t2 := rewrite_S_to_plus_term X2 in + change (t1 = t2) in |- * + | |- (?X1 = ?X2) => + try + let t1 := + (**) (**) + rewrite_S_to_plus_term X1 + with t2 := rewrite_S_to_plus_term X2 in + change (t1 = t2) in |- * + end. -Tactic Definition NatRing := S_to_plus_eq;Ring. +Ltac ring_nat := rewrite_S_to_plus; ring.
\ No newline at end of file diff --git a/contrib/ring/NArithRing.v b/contrib/ring/NArithRing.v index 65814a140..b0a1f1951 100644 --- a/contrib/ring/NArithRing.v +++ b/contrib/ring/NArithRing.v @@ -12,33 +12,33 @@ Require Export Ring. Require Export ZArith_base. -Require NArith. -Require Eqdep_dec. +Require Import NArith. +Require Import Eqdep_dec. -Definition Neq := [n,m:entier] - Cases (Ncompare n m) of - EGAL => true +Definition Neq (n m:N) := + match (n ?= m)%N with + | Datatypes.Eq => true | _ => false end. -Lemma Neq_prop : (n,m:entier)(Is_true (Neq n m)) -> n=m. - Intros n m H; Unfold Neq in H. - Apply Ncompare_Eq_eq. - NewDestruct (Ncompare n m); [Reflexivity | Contradiction | Contradiction ]. -Save. +Lemma Neq_prop : forall n m:N, Is_true (Neq n m) -> n = m. + intros n m H; unfold Neq in H. + apply Ncompare_Eq_eq. + destruct (n ?= m)%N; [ reflexivity | contradiction | contradiction ]. +Qed. -Definition NTheory : (Semi_Ring_Theory Nplus Nmult (Pos xH) Nul Neq). - Split. - Apply Nplus_comm. - Apply Nplus_assoc. - Apply Nmult_comm. - Apply Nmult_assoc. - Apply Nplus_0_l. - Apply Nmult_1_l. - Apply Nmult_0_l. - Apply Nmult_plus_distr_r. - Apply Nplus_reg_l. - Apply Neq_prop. -Save. +Definition NTheory : Semi_Ring_Theory Nplus Nmult 1%N 0%N Neq. + split. + apply Nplus_comm. + apply Nplus_assoc. + apply Nmult_comm. + apply Nmult_assoc. + apply Nplus_0_l. + apply Nmult_1_l. + apply Nmult_0_l. + apply Nmult_plus_distr_r. + apply Nplus_reg_l. + apply Neq_prop. +Qed. -Add Semi Ring entier Nplus Nmult (Pos xH) Nul Neq NTheory [Pos Nul xO xI xH]. +Add Semi Ring N Nplus Nmult 1%N 0%N Neq NTheory [ Npos 0%N xO xI 1%positive ].
\ No newline at end of file diff --git a/contrib/ring/Quote.v b/contrib/ring/Quote.v index e2bd0c537..d50df9776 100644 --- a/contrib/ring/Quote.v +++ b/contrib/ring/Quote.v @@ -32,54 +32,53 @@ Section variables_map. Variable A : Type. Inductive varmap : Type := - Empty_vm : varmap -| Node_vm : A->varmap->varmap->varmap. - -Inductive index : Set := -| Left_idx : index -> index -| Right_idx : index -> index -| End_idx : index -. - -Fixpoint varmap_find [default_value:A; i:index; v:varmap] : A := - Cases i v of - End_idx (Node_vm x _ _) => x - | (Right_idx i1) (Node_vm x v1 v2) => (varmap_find default_value i1 v2) - | (Left_idx i1) (Node_vm x v1 v2) => (varmap_find default_value i1 v1) - | _ _ => default_value + | Empty_vm : varmap + | Node_vm : A -> varmap -> varmap -> varmap. + +Inductive index : Set := + | Left_idx : index -> index + | Right_idx : index -> index + | End_idx : index. + +Fixpoint varmap_find (default_value:A) (i:index) (v:varmap) {struct v} : A := + match i, v with + | End_idx, Node_vm x _ _ => x + | Right_idx i1, Node_vm x v1 v2 => varmap_find default_value i1 v2 + | Left_idx i1, Node_vm x v1 v2 => varmap_find default_value i1 v1 + | _, _ => default_value end. -Fixpoint index_eq [n,m:index] : bool := - Cases n m of - | End_idx End_idx => true - | (Left_idx n') (Left_idx m') => (index_eq n' m') - | (Right_idx n') (Right_idx m') => (index_eq n' m') - | _ _ => false +Fixpoint index_eq (n m:index) {struct m} : bool := + match n, m with + | End_idx, End_idx => true + | Left_idx n', Left_idx m' => index_eq n' m' + | Right_idx n', Right_idx m' => index_eq n' m' + | _, _ => false end. -Fixpoint index_lt[n,m:index] : bool := - Cases n m of - | End_idx (Left_idx _) => true - | End_idx (Right_idx _) => true - | (Left_idx n') (Right_idx m') => true - | (Right_idx n') (Right_idx m') => (index_lt n' m') - | (Left_idx n') (Left_idx m') => (index_lt n' m') - | _ _ => false +Fixpoint index_lt (n m:index) {struct m} : bool := + match n, m with + | End_idx, Left_idx _ => true + | End_idx, Right_idx _ => true + | Left_idx n', Right_idx m' => true + | Right_idx n', Right_idx m' => index_lt n' m' + | Left_idx n', Left_idx m' => index_lt n' m' + | _, _ => false end. -Lemma index_eq_prop : (n,m:index)(index_eq n m)=true -> n=m. - Induction n; Induction m; Simpl; Intros. - Rewrite (H i0 H1); Reflexivity. - Discriminate. - Discriminate. - Discriminate. - Rewrite (H i0 H1); Reflexivity. - Discriminate. - Discriminate. - Discriminate. - Reflexivity. -Save. +Lemma index_eq_prop : forall n m:index, index_eq n m = true -> n = m. + simple induction n; simple induction m; simpl in |- *; intros. + rewrite (H i0 H1); reflexivity. + discriminate. + discriminate. + discriminate. + rewrite (H i0 H1); reflexivity. + discriminate. + discriminate. + discriminate. + reflexivity. +Qed. End variables_map. -Unset Implicit Arguments. +Unset Implicit Arguments.
\ No newline at end of file diff --git a/contrib/ring/Ring.v b/contrib/ring/Ring.v index fa2ba1ca0..942c41d65 100644 --- a/contrib/ring/Ring.v +++ b/contrib/ring/Ring.v @@ -18,17 +18,19 @@ Require Export Ring_abstract. (* Other instatiations are given in ArithRing and ZArithRing in the same directory *) -Definition BoolTheory : (Ring_Theory xorb andb true false [b:bool]b eqb). -Split; Simpl. -NewDestruct n; NewDestruct m; Reflexivity. -NewDestruct n; NewDestruct m; NewDestruct p; Reflexivity. -NewDestruct n; NewDestruct m; Reflexivity. -NewDestruct n; NewDestruct m; NewDestruct p; Reflexivity. -NewDestruct n; Reflexivity. -NewDestruct n; Reflexivity. -NewDestruct n; Reflexivity. -NewDestruct n; NewDestruct m; NewDestruct p; Reflexivity. -NewDestruct x; NewDestruct y; Reflexivity Orelse Simpl; Tauto. +Definition BoolTheory : + Ring_Theory xorb andb true false (fun b:bool => b) eqb. +split; simpl in |- *. +destruct n; destruct m; reflexivity. +destruct n; destruct m; destruct p; reflexivity. +destruct n; destruct m; reflexivity. +destruct n; destruct m; destruct p; reflexivity. +destruct n; reflexivity. +destruct n; reflexivity. +destruct n; reflexivity. +destruct n; destruct m; destruct p; reflexivity. +destruct x; destruct y; reflexivity || simpl in |- *; tauto. Defined. -Add Ring bool xorb andb true false [b:bool]b eqb BoolTheory [ true false ]. +Add Ring bool xorb andb true false (fun b:bool => b) eqb BoolTheory + [ true false ].
\ No newline at end of file diff --git a/contrib/ring/Ring_abstract.v b/contrib/ring/Ring_abstract.v index 98b4cb858..376cfb41f 100644 --- a/contrib/ring/Ring_abstract.v +++ b/contrib/ring/Ring_abstract.v @@ -8,76 +8,75 @@ (* $Id$ *) -Require Ring_theory. -Require Quote. -Require Ring_normalize. +Require Import Ring_theory. +Require Import Quote. +Require Import Ring_normalize. Section abstract_semi_rings. -Inductive Type aspolynomial := - ASPvar : index -> aspolynomial -| ASP0 : aspolynomial -| ASP1 : aspolynomial -| ASPplus : aspolynomial -> aspolynomial -> aspolynomial -| ASPmult : aspolynomial -> aspolynomial -> aspolynomial -. - -Inductive abstract_sum : Type := -| Nil_acs : abstract_sum -| Cons_acs : varlist -> abstract_sum -> abstract_sum -. - -Fixpoint abstract_sum_merge [s1:abstract_sum] - : abstract_sum -> abstract_sum := -Cases s1 of -| (Cons_acs l1 t1) => - Fix asm_aux{asm_aux[s2:abstract_sum] : abstract_sum := - Cases s2 of - | (Cons_acs l2 t2) => - if (varlist_lt l1 l2) - then (Cons_acs l1 (abstract_sum_merge t1 s2)) - else (Cons_acs l2 (asm_aux t2)) - | Nil_acs => s1 - end} -| Nil_acs => [s2]s2 -end. - -Fixpoint abstract_varlist_insert [l1:varlist; s2:abstract_sum] - : abstract_sum := - Cases s2 of - | (Cons_acs l2 t2) => - if (varlist_lt l1 l2) - then (Cons_acs l1 s2) - else (Cons_acs l2 (abstract_varlist_insert l1 t2)) - | Nil_acs => (Cons_acs l1 Nil_acs) +Inductive aspolynomial : Type := + | ASPvar : index -> aspolynomial + | ASP0 : aspolynomial + | ASP1 : aspolynomial + | ASPplus : aspolynomial -> aspolynomial -> aspolynomial + | ASPmult : aspolynomial -> aspolynomial -> aspolynomial. + +Inductive abstract_sum : Type := + | Nil_acs : abstract_sum + | Cons_acs : varlist -> abstract_sum -> abstract_sum. + +Fixpoint abstract_sum_merge (s1:abstract_sum) : + abstract_sum -> abstract_sum := + match s1 with + | Cons_acs l1 t1 => + (fix asm_aux (s2:abstract_sum) : abstract_sum := + match s2 with + | Cons_acs l2 t2 => + if varlist_lt l1 l2 + then Cons_acs l1 (abstract_sum_merge t1 s2) + else Cons_acs l2 (asm_aux t2) + | Nil_acs => s1 + end) + | Nil_acs => fun s2 => s2 end. -Fixpoint abstract_sum_scalar [l1:varlist; s2:abstract_sum] - : abstract_sum := - Cases s2 of - | (Cons_acs l2 t2) => (abstract_varlist_insert (varlist_merge l1 l2) - (abstract_sum_scalar l1 t2)) +Fixpoint abstract_varlist_insert (l1:varlist) (s2:abstract_sum) {struct s2} : + abstract_sum := + match s2 with + | Cons_acs l2 t2 => + if varlist_lt l1 l2 + then Cons_acs l1 s2 + else Cons_acs l2 (abstract_varlist_insert l1 t2) + | Nil_acs => Cons_acs l1 Nil_acs + end. + +Fixpoint abstract_sum_scalar (l1:varlist) (s2:abstract_sum) {struct s2} : + abstract_sum := + match s2 with + | Cons_acs l2 t2 => + abstract_varlist_insert (varlist_merge l1 l2) + (abstract_sum_scalar l1 t2) + | Nil_acs => Nil_acs + end. + +Fixpoint abstract_sum_prod (s1 s2:abstract_sum) {struct s1} : abstract_sum := + match s1 with + | Cons_acs l1 t1 => + abstract_sum_merge (abstract_sum_scalar l1 s2) + (abstract_sum_prod t1 s2) | Nil_acs => Nil_acs end. -Fixpoint abstract_sum_prod [s1:abstract_sum] - : abstract_sum -> abstract_sum := - [s2]Cases s1 of - | (Cons_acs l1 t1) => - (abstract_sum_merge (abstract_sum_scalar l1 s2) - (abstract_sum_prod t1 s2)) - | Nil_acs => Nil_acs - end. - -Fixpoint aspolynomial_normalize[p:aspolynomial] : abstract_sum := - Cases p of - | (ASPvar i) => (Cons_acs (Cons_var i Nil_var) Nil_acs) - | ASP1 => (Cons_acs Nil_var Nil_acs) +Fixpoint aspolynomial_normalize (p:aspolynomial) : abstract_sum := + match p with + | ASPvar i => Cons_acs (Cons_var i Nil_var) Nil_acs + | ASP1 => Cons_acs Nil_var Nil_acs | ASP0 => Nil_acs - | (ASPplus l r) => (abstract_sum_merge (aspolynomial_normalize l) - (aspolynomial_normalize r)) - | (ASPmult l r) => (abstract_sum_prod (aspolynomial_normalize l) - (aspolynomial_normalize r)) + | ASPplus l r => + abstract_sum_merge (aspolynomial_normalize l) + (aspolynomial_normalize r) + | ASPmult l r => + abstract_sum_prod (aspolynomial_normalize l) (aspolynomial_normalize r) end. @@ -88,147 +87,151 @@ Variable Amult : A -> A -> A. Variable Aone : A. Variable Azero : A. Variable Aeq : A -> A -> bool. -Variable vm : (varmap A). -Variable T : (Semi_Ring_Theory Aplus Amult Aone Azero Aeq). +Variable vm : varmap A. +Variable T : Semi_Ring_Theory Aplus Amult Aone Azero Aeq. -Fixpoint interp_asp [p:aspolynomial] : A := - Cases p of - | (ASPvar i) => (interp_var Azero vm i) +Fixpoint interp_asp (p:aspolynomial) : A := + match p with + | ASPvar i => interp_var Azero vm i | ASP0 => Azero | ASP1 => Aone - | (ASPplus l r) => (Aplus (interp_asp l) (interp_asp r)) - | (ASPmult l r) => (Amult (interp_asp l) (interp_asp r)) + | ASPplus l r => Aplus (interp_asp l) (interp_asp r) + | ASPmult l r => Amult (interp_asp l) (interp_asp r) end. -(* Local *) Definition iacs_aux := Fix iacs_aux{iacs_aux [a:A; s:abstract_sum] : A := - Cases s of - | Nil_acs => a - | (Cons_acs l t) => (Aplus a (iacs_aux (interp_vl Amult Aone Azero vm l) t)) - end}. - -Definition interp_acs [s:abstract_sum] : A := - Cases s of - | (Cons_acs l t) => (iacs_aux (interp_vl Amult Aone Azero vm l) t) +(* Local *) Definition iacs_aux := + (fix iacs_aux (a:A) (s:abstract_sum) {struct s} : A := + match s with + | Nil_acs => a + | Cons_acs l t => + Aplus a (iacs_aux (interp_vl Amult Aone Azero vm l) t) + end). + +Definition interp_acs (s:abstract_sum) : A := + match s with + | Cons_acs l t => iacs_aux (interp_vl Amult Aone Azero vm l) t | Nil_acs => Azero end. -Hint SR_plus_sym_T := Resolve (SR_plus_sym T). -Hint SR_plus_assoc_T := Resolve (SR_plus_assoc T). -Hint SR_plus_assoc2_T := Resolve (SR_plus_assoc2 T). -Hint SR_mult_sym_T := Resolve (SR_mult_sym T). -Hint SR_mult_assoc_T := Resolve (SR_mult_assoc T). -Hint SR_mult_assoc2_T := Resolve (SR_mult_assoc2 T). -Hint SR_plus_zero_left_T := Resolve (SR_plus_zero_left T). -Hint SR_plus_zero_left2_T := Resolve (SR_plus_zero_left2 T). -Hint SR_mult_one_left_T := Resolve (SR_mult_one_left T). -Hint SR_mult_one_left2_T := Resolve (SR_mult_one_left2 T). -Hint SR_mult_zero_left_T := Resolve (SR_mult_zero_left T). -Hint SR_mult_zero_left2_T := Resolve (SR_mult_zero_left2 T). -Hint SR_distr_left_T := Resolve (SR_distr_left T). -Hint SR_distr_left2_T := Resolve (SR_distr_left2 T). -Hint SR_plus_reg_left_T := Resolve (SR_plus_reg_left T). -Hint SR_plus_permute_T := Resolve (SR_plus_permute T). -Hint SR_mult_permute_T := Resolve (SR_mult_permute T). -Hint SR_distr_right_T := Resolve (SR_distr_right T). -Hint SR_distr_right2_T := Resolve (SR_distr_right2 T). -Hint SR_mult_zero_right_T := Resolve (SR_mult_zero_right T). -Hint SR_mult_zero_right2_T := Resolve (SR_mult_zero_right2 T). -Hint SR_plus_zero_right_T := Resolve (SR_plus_zero_right T). -Hint SR_plus_zero_right2_T := Resolve (SR_plus_zero_right2 T). -Hint SR_mult_one_right_T := Resolve (SR_mult_one_right T). -Hint SR_mult_one_right2_T := Resolve (SR_mult_one_right2 T). -Hint SR_plus_reg_right_T := Resolve (SR_plus_reg_right T). -Hints Resolve refl_equal sym_equal trans_equal. +Hint Resolve (SR_plus_comm T). +Hint Resolve (SR_plus_assoc T). +Hint Resolve (SR_plus_assoc2 T). +Hint Resolve (SR_mult_comm T). +Hint Resolve (SR_mult_assoc T). +Hint Resolve (SR_mult_assoc2 T). +Hint Resolve (SR_plus_zero_left T). +Hint Resolve (SR_plus_zero_left2 T). +Hint Resolve (SR_mult_one_left T). +Hint Resolve (SR_mult_one_left2 T). +Hint Resolve (SR_mult_zero_left T). +Hint Resolve (SR_mult_zero_left2 T). +Hint Resolve (SR_distr_left T). +Hint Resolve (SR_distr_left2 T). +Hint Resolve (SR_plus_reg_left T). +Hint Resolve (SR_plus_permute T). +Hint Resolve (SR_mult_permute T). +Hint Resolve (SR_distr_right T). +Hint Resolve (SR_distr_right2 T). +Hint Resolve (SR_mult_zero_right T). +Hint Resolve (SR_mult_zero_right2 T). +Hint Resolve (SR_plus_zero_right T). +Hint Resolve (SR_plus_zero_right2 T). +Hint Resolve (SR_mult_one_right T). +Hint Resolve (SR_mult_one_right2 T). +Hint Resolve (SR_plus_reg_right T). +Hint Resolve refl_equal sym_equal trans_equal. (*Hints Resolve refl_eqT sym_eqT trans_eqT.*) -Hints Immediate T. +Hint Immediate T. -Remark iacs_aux_ok : (x:A)(s:abstract_sum) - (iacs_aux x s)==(Aplus x (interp_acs s)). +Remark iacs_aux_ok : + forall (x:A) (s:abstract_sum), iacs_aux x s = Aplus x (interp_acs s). Proof. - Induction s; Simpl; Intros. - Trivial. - Reflexivity. -Save. + simple induction s; simpl in |- *; intros. + trivial. + reflexivity. +Qed. -Hint rew_iacs_aux : core := Extern 10 (eqT A ? ?) Rewrite iacs_aux_ok. +Hint Extern 10 (_ = _ :>A) => rewrite iacs_aux_ok: core. -Lemma abstract_varlist_insert_ok : (l:varlist)(s:abstract_sum) - (interp_acs (abstract_varlist_insert l s)) - ==(Aplus (interp_vl Amult Aone Azero vm l) (interp_acs s)). +Lemma abstract_varlist_insert_ok : + forall (l:varlist) (s:abstract_sum), + interp_acs (abstract_varlist_insert l s) = + Aplus (interp_vl Amult Aone Azero vm l) (interp_acs s). - Induction s. - Trivial. + simple induction s. + trivial. - Simpl; Intros. - Elim (varlist_lt l v); Simpl. - EAuto. - Rewrite iacs_aux_ok. - Rewrite H; Auto. + simpl in |- *; intros. + elim (varlist_lt l v); simpl in |- *. + eauto. + rewrite iacs_aux_ok. + rewrite H; auto. -Save. +Qed. -Lemma abstract_sum_merge_ok : (x,y:abstract_sum) - (interp_acs (abstract_sum_merge x y)) - ==(Aplus (interp_acs x) (interp_acs y)). +Lemma abstract_sum_merge_ok : + forall x y:abstract_sum, + interp_acs (abstract_sum_merge x y) = Aplus (interp_acs x) (interp_acs y). Proof. - Induction x. - Trivial. - Induction y; Intros. + simple induction x. + trivial. + simple induction y; intros. - Auto. + auto. - Simpl; Elim (varlist_lt v v0); Simpl. - Repeat Rewrite iacs_aux_ok. - Rewrite H; Simpl; Auto. + simpl in |- *; elim (varlist_lt v v0); simpl in |- *. + repeat rewrite iacs_aux_ok. + rewrite H; simpl in |- *; auto. - Simpl in H0. - Repeat Rewrite iacs_aux_ok. - Rewrite H0. Simpl; Auto. -Save. + simpl in H0. + repeat rewrite iacs_aux_ok. + rewrite H0. simpl in |- *; auto. +Qed. -Lemma abstract_sum_scalar_ok : (l:varlist)(s:abstract_sum) - (interp_acs (abstract_sum_scalar l s)) - == (Amult (interp_vl Amult Aone Azero vm l) (interp_acs s)). +Lemma abstract_sum_scalar_ok : + forall (l:varlist) (s:abstract_sum), + interp_acs (abstract_sum_scalar l s) = + Amult (interp_vl Amult Aone Azero vm l) (interp_acs s). Proof. - Induction s. - Simpl; EAuto. + simple induction s. + simpl in |- *; eauto. - Simpl; Intros. - Rewrite iacs_aux_ok. - Rewrite abstract_varlist_insert_ok. - Rewrite H. - Rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T). - Auto. -Save. + simpl in |- *; intros. + rewrite iacs_aux_ok. + rewrite abstract_varlist_insert_ok. + rewrite H. + rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T). + auto. +Qed. -Lemma abstract_sum_prod_ok : (x,y:abstract_sum) - (interp_acs (abstract_sum_prod x y)) - == (Amult (interp_acs x) (interp_acs y)). +Lemma abstract_sum_prod_ok : + forall x y:abstract_sum, + interp_acs (abstract_sum_prod x y) = Amult (interp_acs x) (interp_acs y). Proof. - Induction x. - Intros; Simpl; EAuto. + simple induction x. + intros; simpl in |- *; eauto. - NewDestruct y; Intros. + destruct y as [| v0 a0]; intros. - Simpl; Rewrite H; EAuto. + simpl in |- *; rewrite H; eauto. - Unfold abstract_sum_prod; Fold abstract_sum_prod. - Rewrite abstract_sum_merge_ok. - Rewrite abstract_sum_scalar_ok. - Rewrite H; Simpl; Auto. -Save. + unfold abstract_sum_prod in |- *; fold abstract_sum_prod in |- *. + rewrite abstract_sum_merge_ok. + rewrite abstract_sum_scalar_ok. + rewrite H; simpl in |- *; auto. +Qed. -Theorem aspolynomial_normalize_ok : (x:aspolynomial) - (interp_asp x)==(interp_acs (aspolynomial_normalize x)). +Theorem aspolynomial_normalize_ok : + forall x:aspolynomial, interp_asp x = interp_acs (aspolynomial_normalize x). Proof. - Induction x; Simpl; Intros; Trivial. - Rewrite abstract_sum_merge_ok. - Rewrite H; Rewrite H0; EAuto. - Rewrite abstract_sum_prod_ok. - Rewrite H; Rewrite H0; EAuto. -Save. + simple induction x; simpl in |- *; intros; trivial. + rewrite abstract_sum_merge_ok. + rewrite H; rewrite H0; eauto. + rewrite abstract_sum_prod_ok. + rewrite H; rewrite H0; eauto. +Qed. End abstract_semi_rings. @@ -244,143 +247,141 @@ Section abstract_rings. Nevertheless, they are two different types for semi-rings and rings and there will be 2 correction theorems *) -Inductive Type apolynomial := - APvar : index -> apolynomial -| AP0 : apolynomial -| AP1 : apolynomial -| APplus : apolynomial -> apolynomial -> apolynomial -| APmult : apolynomial -> apolynomial -> apolynomial -| APopp : apolynomial -> apolynomial -. +Inductive apolynomial : Type := + | APvar : index -> apolynomial + | AP0 : apolynomial + | AP1 : apolynomial + | APplus : apolynomial -> apolynomial -> apolynomial + | APmult : apolynomial -> apolynomial -> apolynomial + | APopp : apolynomial -> apolynomial. (* A canonical "abstract" sum is a list of varlist with the sign "+" or "-". Invariant : the list is sorted and there is no varlist is present with both signs. +x +x +x -x is forbidden => the canonical form is +x+x *) -Inductive signed_sum : Type := -| Nil_varlist : signed_sum -| Plus_varlist : varlist -> signed_sum -> signed_sum -| Minus_varlist : varlist -> signed_sum -> signed_sum -. - -Fixpoint signed_sum_merge [s1:signed_sum] - : signed_sum -> signed_sum := -Cases s1 of -| (Plus_varlist l1 t1) => - Fix ssm_aux{ssm_aux[s2:signed_sum] : signed_sum := - Cases s2 of - | (Plus_varlist l2 t2) => - if (varlist_lt l1 l2) - then (Plus_varlist l1 (signed_sum_merge t1 s2)) - else (Plus_varlist l2 (ssm_aux t2)) - | (Minus_varlist l2 t2) => - if (varlist_eq l1 l2) - then (signed_sum_merge t1 t2) - else if (varlist_lt l1 l2) - then (Plus_varlist l1 (signed_sum_merge t1 s2)) - else (Minus_varlist l2 (ssm_aux t2)) - | Nil_varlist => s1 - end} -| (Minus_varlist l1 t1) => - Fix ssm_aux2{ssm_aux2[s2:signed_sum] : signed_sum := - Cases s2 of - | (Plus_varlist l2 t2) => - if (varlist_eq l1 l2) - then (signed_sum_merge t1 t2) - else if (varlist_lt l1 l2) - then (Minus_varlist l1 (signed_sum_merge t1 s2)) - else (Plus_varlist l2 (ssm_aux2 t2)) - | (Minus_varlist l2 t2) => - if (varlist_lt l1 l2) - then (Minus_varlist l1 (signed_sum_merge t1 s2)) - else (Minus_varlist l2 (ssm_aux2 t2)) - | Nil_varlist => s1 - end} -| Nil_varlist => [s2]s2 -end. - -Fixpoint plus_varlist_insert [l1:varlist; s2:signed_sum] - : signed_sum := - Cases s2 of - | (Plus_varlist l2 t2) => - if (varlist_lt l1 l2) - then (Plus_varlist l1 s2) - else (Plus_varlist l2 (plus_varlist_insert l1 t2)) - | (Minus_varlist l2 t2) => - if (varlist_eq l1 l2) - then t2 - else if (varlist_lt l1 l2) - then (Plus_varlist l1 s2) - else (Minus_varlist l2 (plus_varlist_insert l1 t2)) - | Nil_varlist => (Plus_varlist l1 Nil_varlist) +Inductive signed_sum : Type := + | Nil_varlist : signed_sum + | Plus_varlist : varlist -> signed_sum -> signed_sum + | Minus_varlist : varlist -> signed_sum -> signed_sum. + +Fixpoint signed_sum_merge (s1:signed_sum) : signed_sum -> signed_sum := + match s1 with + | Plus_varlist l1 t1 => + (fix ssm_aux (s2:signed_sum) : signed_sum := + match s2 with + | Plus_varlist l2 t2 => + if varlist_lt l1 l2 + then Plus_varlist l1 (signed_sum_merge t1 s2) + else Plus_varlist l2 (ssm_aux t2) + | Minus_varlist l2 t2 => + if varlist_eq l1 l2 + then signed_sum_merge t1 t2 + else + if varlist_lt l1 l2 + then Plus_varlist l1 (signed_sum_merge t1 s2) + else Minus_varlist l2 (ssm_aux t2) + | Nil_varlist => s1 + end) + | Minus_varlist l1 t1 => + (fix ssm_aux2 (s2:signed_sum) : signed_sum := + match s2 with + | Plus_varlist l2 t2 => + if varlist_eq l1 l2 + then signed_sum_merge t1 t2 + else + if varlist_lt l1 l2 + then Minus_varlist l1 (signed_sum_merge t1 s2) + else Plus_varlist l2 (ssm_aux2 t2) + | Minus_varlist l2 t2 => + if varlist_lt l1 l2 + then Minus_varlist l1 (signed_sum_merge t1 s2) + else Minus_varlist l2 (ssm_aux2 t2) + | Nil_varlist => s1 + end) + | Nil_varlist => fun s2 => s2 end. -Fixpoint minus_varlist_insert [l1:varlist; s2:signed_sum] - : signed_sum := - Cases s2 of - | (Plus_varlist l2 t2) => - if (varlist_eq l1 l2) - then t2 - else if (varlist_lt l1 l2) - then (Minus_varlist l1 s2) - else (Plus_varlist l2 (minus_varlist_insert l1 t2)) - | (Minus_varlist l2 t2) => - if (varlist_lt l1 l2) - then (Minus_varlist l1 s2) - else (Minus_varlist l2 (minus_varlist_insert l1 t2)) - | Nil_varlist => (Minus_varlist l1 Nil_varlist) +Fixpoint plus_varlist_insert (l1:varlist) (s2:signed_sum) {struct s2} : + signed_sum := + match s2 with + | Plus_varlist l2 t2 => + if varlist_lt l1 l2 + then Plus_varlist l1 s2 + else Plus_varlist l2 (plus_varlist_insert l1 t2) + | Minus_varlist l2 t2 => + if varlist_eq l1 l2 + then t2 + else + if varlist_lt l1 l2 + then Plus_varlist l1 s2 + else Minus_varlist l2 (plus_varlist_insert l1 t2) + | Nil_varlist => Plus_varlist l1 Nil_varlist end. -Fixpoint signed_sum_opp [s:signed_sum] : signed_sum := - Cases s of - | (Plus_varlist l2 t2) => (Minus_varlist l2 (signed_sum_opp t2)) - | (Minus_varlist l2 t2) => (Plus_varlist l2 (signed_sum_opp t2)) +Fixpoint minus_varlist_insert (l1:varlist) (s2:signed_sum) {struct s2} : + signed_sum := + match s2 with + | Plus_varlist l2 t2 => + if varlist_eq l1 l2 + then t2 + else + if varlist_lt l1 l2 + then Minus_varlist l1 s2 + else Plus_varlist l2 (minus_varlist_insert l1 t2) + | Minus_varlist l2 t2 => + if varlist_lt l1 l2 + then Minus_varlist l1 s2 + else Minus_varlist l2 (minus_varlist_insert l1 t2) + | Nil_varlist => Minus_varlist l1 Nil_varlist + end. + +Fixpoint signed_sum_opp (s:signed_sum) : signed_sum := + match s with + | Plus_varlist l2 t2 => Minus_varlist l2 (signed_sum_opp t2) + | Minus_varlist l2 t2 => Plus_varlist l2 (signed_sum_opp t2) | Nil_varlist => Nil_varlist end. -Fixpoint plus_sum_scalar [l1:varlist; s2:signed_sum] - : signed_sum := - Cases s2 of - | (Plus_varlist l2 t2) => (plus_varlist_insert (varlist_merge l1 l2) - (plus_sum_scalar l1 t2)) - | (Minus_varlist l2 t2) => (minus_varlist_insert (varlist_merge l1 l2) - (plus_sum_scalar l1 t2)) +Fixpoint plus_sum_scalar (l1:varlist) (s2:signed_sum) {struct s2} : + signed_sum := + match s2 with + | Plus_varlist l2 t2 => + plus_varlist_insert (varlist_merge l1 l2) (plus_sum_scalar l1 t2) + | Minus_varlist l2 t2 => + minus_varlist_insert (varlist_merge l1 l2) (plus_sum_scalar l1 t2) + | Nil_varlist => Nil_varlist + end. + +Fixpoint minus_sum_scalar (l1:varlist) (s2:signed_sum) {struct s2} : + signed_sum := + match s2 with + | Plus_varlist l2 t2 => + minus_varlist_insert (varlist_merge l1 l2) (minus_sum_scalar l1 t2) + | Minus_varlist l2 t2 => + plus_varlist_insert (varlist_merge l1 l2) (minus_sum_scalar l1 t2) | Nil_varlist => Nil_varlist end. -Fixpoint minus_sum_scalar [l1:varlist; s2:signed_sum] - : signed_sum := - Cases s2 of - | (Plus_varlist l2 t2) => (minus_varlist_insert (varlist_merge l1 l2) - (minus_sum_scalar l1 t2)) - | (Minus_varlist l2 t2) => (plus_varlist_insert (varlist_merge l1 l2) - (minus_sum_scalar l1 t2)) +Fixpoint signed_sum_prod (s1 s2:signed_sum) {struct s1} : signed_sum := + match s1 with + | Plus_varlist l1 t1 => + signed_sum_merge (plus_sum_scalar l1 s2) (signed_sum_prod t1 s2) + | Minus_varlist l1 t1 => + signed_sum_merge (minus_sum_scalar l1 s2) (signed_sum_prod t1 s2) | Nil_varlist => Nil_varlist end. -Fixpoint signed_sum_prod [s1:signed_sum] - : signed_sum -> signed_sum := - [s2]Cases s1 of - | (Plus_varlist l1 t1) => - (signed_sum_merge (plus_sum_scalar l1 s2) - (signed_sum_prod t1 s2)) - | (Minus_varlist l1 t1) => - (signed_sum_merge (minus_sum_scalar l1 s2) - (signed_sum_prod t1 s2)) - | Nil_varlist => Nil_varlist - end. - -Fixpoint apolynomial_normalize[p:apolynomial] : signed_sum := - Cases p of - | (APvar i) => (Plus_varlist (Cons_var i Nil_var) Nil_varlist) - | AP1 => (Plus_varlist Nil_var Nil_varlist) +Fixpoint apolynomial_normalize (p:apolynomial) : signed_sum := + match p with + | APvar i => Plus_varlist (Cons_var i Nil_var) Nil_varlist + | AP1 => Plus_varlist Nil_var Nil_varlist | AP0 => Nil_varlist - | (APplus l r) => (signed_sum_merge (apolynomial_normalize l) - (apolynomial_normalize r)) - | (APmult l r) => (signed_sum_prod (apolynomial_normalize l) - (apolynomial_normalize r)) - | (APopp q) => (signed_sum_opp (apolynomial_normalize q)) + | APplus l r => + signed_sum_merge (apolynomial_normalize l) (apolynomial_normalize r) + | APmult l r => + signed_sum_prod (apolynomial_normalize l) (apolynomial_normalize r) + | APopp q => signed_sum_opp (apolynomial_normalize q) end. @@ -389,311 +390,315 @@ Variable Aplus : A -> A -> A. Variable Amult : A -> A -> A. Variable Aone : A. Variable Azero : A. -Variable Aopp :A -> A. +Variable Aopp : A -> A. Variable Aeq : A -> A -> bool. -Variable vm : (varmap A). -Variable T : (Ring_Theory Aplus Amult Aone Azero Aopp Aeq). - -(* Local *) Definition isacs_aux := Fix isacs_aux{isacs_aux [a:A; s:signed_sum] : A := - Cases s of - | Nil_varlist => a - | (Plus_varlist l t) => - (Aplus a (isacs_aux (interp_vl Amult Aone Azero vm l) t)) - | (Minus_varlist l t) => - (Aplus a (isacs_aux (Aopp (interp_vl Amult Aone Azero vm l)) t)) - end}. - -Definition interp_sacs [s:signed_sum] : A := - Cases s of - | (Plus_varlist l t) => (isacs_aux (interp_vl Amult Aone Azero vm l) t) - | (Minus_varlist l t) => - (isacs_aux (Aopp (interp_vl Amult Aone Azero vm l)) t) +Variable vm : varmap A. +Variable T : Ring_Theory Aplus Amult Aone Azero Aopp Aeq. + +(* Local *) Definition isacs_aux := + (fix isacs_aux (a:A) (s:signed_sum) {struct s} : A := + match s with + | Nil_varlist => a + | Plus_varlist l t => + Aplus a (isacs_aux (interp_vl Amult Aone Azero vm l) t) + | Minus_varlist l t => + Aplus a + (isacs_aux (Aopp (interp_vl Amult Aone Azero vm l)) t) + end). + +Definition interp_sacs (s:signed_sum) : A := + match s with + | Plus_varlist l t => isacs_aux (interp_vl Amult Aone Azero vm l) t + | Minus_varlist l t => isacs_aux (Aopp (interp_vl Amult Aone Azero vm l)) t | Nil_varlist => Azero end. -Fixpoint interp_ap [p:apolynomial] : A := - Cases p of - | (APvar i) => (interp_var Azero vm i) +Fixpoint interp_ap (p:apolynomial) : A := + match p with + | APvar i => interp_var Azero vm i | AP0 => Azero | AP1 => Aone - | (APplus l r) => (Aplus (interp_ap l) (interp_ap r)) - | (APmult l r) => (Amult (interp_ap l) (interp_ap r)) - | (APopp q) => (Aopp (interp_ap q)) + | APplus l r => Aplus (interp_ap l) (interp_ap r) + | APmult l r => Amult (interp_ap l) (interp_ap r) + | APopp q => Aopp (interp_ap q) end. -Hint Th_plus_sym_T := Resolve (Th_plus_sym T). -Hint Th_plus_assoc_T := Resolve (Th_plus_assoc T). -Hint Th_plus_assoc2_T := Resolve (Th_plus_assoc2 T). -Hint Th_mult_sym_T := Resolve (Th_mult_sym T). -Hint Th_mult_assoc_T := Resolve (Th_mult_assoc T). -Hint Th_mult_assoc2_T := Resolve (Th_mult_assoc2 T). -Hint Th_plus_zero_left_T := Resolve (Th_plus_zero_left T). -Hint Th_plus_zero_left2_T := Resolve (Th_plus_zero_left2 T). -Hint Th_mult_one_left_T := Resolve (Th_mult_one_left T). -Hint Th_mult_one_left2_T := Resolve (Th_mult_one_left2 T). -Hint Th_mult_zero_left_T := Resolve (Th_mult_zero_left T). -Hint Th_mult_zero_left2_T := Resolve (Th_mult_zero_left2 T). -Hint Th_distr_left_T := Resolve (Th_distr_left T). -Hint Th_distr_left2_T := Resolve (Th_distr_left2 T). -Hint Th_plus_reg_left_T := Resolve (Th_plus_reg_left T). -Hint Th_plus_permute_T := Resolve (Th_plus_permute T). -Hint Th_mult_permute_T := Resolve (Th_mult_permute T). -Hint Th_distr_right_T := Resolve (Th_distr_right T). -Hint Th_distr_right2_T := Resolve (Th_distr_right2 T). -Hint Th_mult_zero_right2_T := Resolve (Th_mult_zero_right2 T). -Hint Th_plus_zero_right_T := Resolve (Th_plus_zero_right T). -Hint Th_plus_zero_right2_T := Resolve (Th_plus_zero_right2 T). -Hint Th_mult_one_right_T := Resolve (Th_mult_one_right T). -Hint Th_mult_one_right2_T := Resolve (Th_mult_one_right2 T). -Hint Th_plus_reg_right_T := Resolve (Th_plus_reg_right T). -Hints Resolve refl_equal sym_equal trans_equal. +Hint Resolve (Th_plus_comm T). +Hint Resolve (Th_plus_assoc T). +Hint Resolve (Th_plus_assoc2 T). +Hint Resolve (Th_mult_sym T). +Hint Resolve (Th_mult_assoc T). +Hint Resolve (Th_mult_assoc2 T). +Hint Resolve (Th_plus_zero_left T). +Hint Resolve (Th_plus_zero_left2 T). +Hint Resolve (Th_mult_one_left T). +Hint Resolve (Th_mult_one_left2 T). +Hint Resolve (Th_mult_zero_left T). +Hint Resolve (Th_mult_zero_left2 T). +Hint Resolve (Th_distr_left T). +Hint Resolve (Th_distr_left2 T). +Hint Resolve (Th_plus_reg_left T). +Hint Resolve (Th_plus_permute T). +Hint Resolve (Th_mult_permute T). +Hint Resolve (Th_distr_right T). +Hint Resolve (Th_distr_right2 T). +Hint Resolve (Th_mult_zero_right2 T). +Hint Resolve (Th_plus_zero_right T). +Hint Resolve (Th_plus_zero_right2 T). +Hint Resolve (Th_mult_one_right T). +Hint Resolve (Th_mult_one_right2 T). +Hint Resolve (Th_plus_reg_right T). +Hint Resolve refl_equal sym_equal trans_equal. (*Hints Resolve refl_eqT sym_eqT trans_eqT.*) -Hints Immediate T. +Hint Immediate T. -Lemma isacs_aux_ok : (x:A)(s:signed_sum) - (isacs_aux x s)==(Aplus x (interp_sacs s)). +Lemma isacs_aux_ok : + forall (x:A) (s:signed_sum), isacs_aux x s = Aplus x (interp_sacs s). Proof. - Induction s; Simpl; Intros. - Trivial. - Reflexivity. - Reflexivity. -Save. + simple induction s; simpl in |- *; intros. + trivial. + reflexivity. + reflexivity. +Qed. -Hint rew_isacs_aux : core := Extern 10 (eqT A ? ?) Rewrite isacs_aux_ok. +Hint Extern 10 (_ = _ :>A) => rewrite isacs_aux_ok: core. -Tactic Definition Solve1 v v0 H H0 := - Simpl; Elim (varlist_lt v v0); Simpl; Rewrite isacs_aux_ok; - [Rewrite H; Simpl; Auto - |Simpl in H0; Rewrite H0; Auto ]. +Ltac solve1 v v0 H H0 := + simpl in |- *; elim (varlist_lt v v0); simpl in |- *; rewrite isacs_aux_ok; + [ rewrite H; simpl in |- *; auto | simpl in H0; rewrite H0; auto ]. -Lemma signed_sum_merge_ok : (x,y:signed_sum) - (interp_sacs (signed_sum_merge x y)) - ==(Aplus (interp_sacs x) (interp_sacs y)). +Lemma signed_sum_merge_ok : + forall x y:signed_sum, + interp_sacs (signed_sum_merge x y) = Aplus (interp_sacs x) (interp_sacs y). - Induction x. - Intro; Simpl; Auto. + simple induction x. + intro; simpl in |- *; auto. - Induction y; Intros. + simple induction y; intros. - Auto. + auto. - Solve1 v v0 H H0. + solve1 v v0 H H0. - Simpl; Generalize (varlist_eq_prop v v0). - Elim (varlist_eq v v0); Simpl. + simpl in |- *; generalize (varlist_eq_prop v v0). + elim (varlist_eq v v0); simpl in |- *. - Intro Heq; Rewrite (Heq I). - Rewrite H. - Repeat Rewrite isacs_aux_ok. - Rewrite (Th_plus_permute T). - Repeat Rewrite (Th_plus_assoc T). - Rewrite (Th_plus_sym T (Aopp (interp_vl Amult Aone Azero vm v0)) - (interp_vl Amult Aone Azero vm v0)). - Rewrite (Th_opp_def T). - Rewrite (Th_plus_zero_left T). - Reflexivity. + intro Heq; rewrite (Heq I). + rewrite H. + repeat rewrite isacs_aux_ok. + rewrite (Th_plus_permute T). + repeat rewrite (Th_plus_assoc T). + rewrite + (Th_plus_comm T (Aopp (interp_vl Amult Aone Azero vm v0)) + (interp_vl Amult Aone Azero vm v0)). + rewrite (Th_opp_def T). + rewrite (Th_plus_zero_left T). + reflexivity. - Solve1 v v0 H H0. + solve1 v v0 H H0. - Induction y; Intros. + simple induction y; intros. - Auto. + auto. - Simpl; Generalize (varlist_eq_prop v v0). - Elim (varlist_eq v v0); Simpl. + simpl in |- *; generalize (varlist_eq_prop v v0). + elim (varlist_eq v v0); simpl in |- *. - Intro Heq; Rewrite (Heq I). - Rewrite H. - Repeat Rewrite isacs_aux_ok. - Rewrite (Th_plus_permute T). - Repeat Rewrite (Th_plus_assoc T). - Rewrite (Th_opp_def T). - Rewrite (Th_plus_zero_left T). - Reflexivity. + intro Heq; rewrite (Heq I). + rewrite H. + repeat rewrite isacs_aux_ok. + rewrite (Th_plus_permute T). + repeat rewrite (Th_plus_assoc T). + rewrite (Th_opp_def T). + rewrite (Th_plus_zero_left T). + reflexivity. - Solve1 v v0 H H0. + solve1 v v0 H H0. - Solve1 v v0 H H0. + solve1 v v0 H H0. -Save. +Qed. -Tactic Definition Solve2 l v H := - Elim (varlist_lt l v); Simpl; Rewrite isacs_aux_ok; - [ Auto - | Rewrite H; Auto ]. +Ltac solve2 l v H := + elim (varlist_lt l v); simpl in |- *; rewrite isacs_aux_ok; + [ auto | rewrite H; auto ]. -Lemma plus_varlist_insert_ok : (l:varlist)(s:signed_sum) - (interp_sacs (plus_varlist_insert l s)) - == (Aplus (interp_vl Amult Aone Azero vm l) (interp_sacs s)). +Lemma plus_varlist_insert_ok : + forall (l:varlist) (s:signed_sum), + interp_sacs (plus_varlist_insert l s) = + Aplus (interp_vl Amult Aone Azero vm l) (interp_sacs s). Proof. - Induction s. - Trivial. + simple induction s. + trivial. - Simpl; Intros. - Solve2 l v H. + simpl in |- *; intros. + solve2 l v H. - Simpl; Intros. - Generalize (varlist_eq_prop l v). - Elim (varlist_eq l v); Simpl. + simpl in |- *; intros. + generalize (varlist_eq_prop l v). + elim (varlist_eq l v); simpl in |- *. - Intro Heq; Rewrite (Heq I). - Repeat Rewrite isacs_aux_ok. - Repeat Rewrite (Th_plus_assoc T). - Rewrite (Th_opp_def T). - Rewrite (Th_plus_zero_left T). - Reflexivity. + intro Heq; rewrite (Heq I). + repeat rewrite isacs_aux_ok. + repeat rewrite (Th_plus_assoc T). + rewrite (Th_opp_def T). + rewrite (Th_plus_zero_left T). + reflexivity. - Solve2 l v H. + solve2 l v H. -Save. +Qed. -Lemma minus_varlist_insert_ok : (l:varlist)(s:signed_sum) - (interp_sacs (minus_varlist_insert l s)) - == (Aplus (Aopp (interp_vl Amult Aone Azero vm l)) (interp_sacs s)). +Lemma minus_varlist_insert_ok : + forall (l:varlist) (s:signed_sum), + interp_sacs (minus_varlist_insert l s) = + Aplus (Aopp (interp_vl Amult Aone Azero vm l)) (interp_sacs s). Proof. - Induction s. - Trivial. + simple induction s. + trivial. - Simpl; Intros. - Generalize (varlist_eq_prop l v). - Elim (varlist_eq l v); Simpl. + simpl in |- *; intros. + generalize (varlist_eq_prop l v). + elim (varlist_eq l v); simpl in |- *. - Intro Heq; Rewrite (Heq I). - Repeat Rewrite isacs_aux_ok. - Repeat Rewrite (Th_plus_assoc T). - Rewrite (Th_plus_sym T (Aopp (interp_vl Amult Aone Azero vm v)) - (interp_vl Amult Aone Azero vm v)). - Rewrite (Th_opp_def T). - Auto. + intro Heq; rewrite (Heq I). + repeat rewrite isacs_aux_ok. + repeat rewrite (Th_plus_assoc T). + rewrite + (Th_plus_comm T (Aopp (interp_vl Amult Aone Azero vm v)) + (interp_vl Amult Aone Azero vm v)). + rewrite (Th_opp_def T). + auto. - Simpl; Intros. - Solve2 l v H. + simpl in |- *; intros. + solve2 l v H. - Simpl; Intros; Solve2 l v H. + simpl in |- *; intros; solve2 l v H. -Save. +Qed. -Lemma signed_sum_opp_ok : (s:signed_sum) - (interp_sacs (signed_sum_opp s)) - == (Aopp (interp_sacs s)). +Lemma signed_sum_opp_ok : + forall s:signed_sum, interp_sacs (signed_sum_opp s) = Aopp (interp_sacs s). Proof. - Induction s; Simpl; Intros. + simple induction s; simpl in |- *; intros. - Symmetry; Apply (Th_opp_zero T). + symmetry in |- *; apply (Th_opp_zero T). - Repeat Rewrite isacs_aux_ok. - Rewrite H. - Rewrite (Th_plus_opp_opp T). - Reflexivity. + repeat rewrite isacs_aux_ok. + rewrite H. + rewrite (Th_plus_opp_opp T). + reflexivity. - Repeat Rewrite isacs_aux_ok. - Rewrite H. - Rewrite <- (Th_plus_opp_opp T). - Rewrite (Th_opp_opp T). - Reflexivity. + repeat rewrite isacs_aux_ok. + rewrite H. + rewrite <- (Th_plus_opp_opp T). + rewrite (Th_opp_opp T). + reflexivity. -Save. +Qed. -Lemma plus_sum_scalar_ok : (l:varlist)(s:signed_sum) - (interp_sacs (plus_sum_scalar l s)) - == (Amult (interp_vl Amult Aone Azero vm l) (interp_sacs s)). +Lemma plus_sum_scalar_ok : + forall (l:varlist) (s:signed_sum), + interp_sacs (plus_sum_scalar l s) = + Amult (interp_vl Amult Aone Azero vm l) (interp_sacs s). Proof. - Induction s. - Trivial. - - Simpl; Intros. - Rewrite plus_varlist_insert_ok. - Rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T). - Repeat Rewrite isacs_aux_ok. - Rewrite H. - Auto. - - Simpl; Intros. - Rewrite minus_varlist_insert_ok. - Repeat Rewrite isacs_aux_ok. - Rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T). - Rewrite H. - Rewrite (Th_distr_right T). - Rewrite <- (Th_opp_mult_right T). - Reflexivity. - -Save. - -Lemma minus_sum_scalar_ok : (l:varlist)(s:signed_sum) - (interp_sacs (minus_sum_scalar l s)) - == (Aopp (Amult (interp_vl Amult Aone Azero vm l) (interp_sacs s))). + simple induction s. + trivial. + + simpl in |- *; intros. + rewrite plus_varlist_insert_ok. + rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T). + repeat rewrite isacs_aux_ok. + rewrite H. + auto. + + simpl in |- *; intros. + rewrite minus_varlist_insert_ok. + repeat rewrite isacs_aux_ok. + rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T). + rewrite H. + rewrite (Th_distr_right T). + rewrite <- (Th_opp_mult_right T). + reflexivity. + +Qed. + +Lemma minus_sum_scalar_ok : + forall (l:varlist) (s:signed_sum), + interp_sacs (minus_sum_scalar l s) = + Aopp (Amult (interp_vl Amult Aone Azero vm l) (interp_sacs s)). Proof. - Induction s; Simpl; Intros. - - Rewrite (Th_mult_zero_right T); Symmetry; Apply (Th_opp_zero T). - - Simpl; Intros. - Rewrite minus_varlist_insert_ok. - Rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T). - Repeat Rewrite isacs_aux_ok. - Rewrite H. - Rewrite (Th_distr_right T). - Rewrite (Th_plus_opp_opp T). - Reflexivity. - - Simpl; Intros. - Rewrite plus_varlist_insert_ok. - Repeat Rewrite isacs_aux_ok. - Rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T). - Rewrite H. - Rewrite (Th_distr_right T). - Rewrite <- (Th_opp_mult_right T). - Rewrite <- (Th_plus_opp_opp T). - Rewrite (Th_opp_opp T). - Reflexivity. - -Save. - -Lemma signed_sum_prod_ok : (x,y:signed_sum) - (interp_sacs (signed_sum_prod x y)) == - (Amult (interp_sacs x) (interp_sacs y)). + simple induction s; simpl in |- *; intros. + + rewrite (Th_mult_zero_right T); symmetry in |- *; apply (Th_opp_zero T). + + simpl in |- *; intros. + rewrite minus_varlist_insert_ok. + rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T). + repeat rewrite isacs_aux_ok. + rewrite H. + rewrite (Th_distr_right T). + rewrite (Th_plus_opp_opp T). + reflexivity. + + simpl in |- *; intros. + rewrite plus_varlist_insert_ok. + repeat rewrite isacs_aux_ok. + rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T). + rewrite H. + rewrite (Th_distr_right T). + rewrite <- (Th_opp_mult_right T). + rewrite <- (Th_plus_opp_opp T). + rewrite (Th_opp_opp T). + reflexivity. + +Qed. + +Lemma signed_sum_prod_ok : + forall x y:signed_sum, + interp_sacs (signed_sum_prod x y) = Amult (interp_sacs x) (interp_sacs y). Proof. - Induction x. + simple induction x. - Simpl; EAuto 1. + simpl in |- *; eauto 1. - Intros; Simpl. - Rewrite signed_sum_merge_ok. - Rewrite plus_sum_scalar_ok. - Repeat Rewrite isacs_aux_ok. - Rewrite H. - Auto. + intros; simpl in |- *. + rewrite signed_sum_merge_ok. + rewrite plus_sum_scalar_ok. + repeat rewrite isacs_aux_ok. + rewrite H. + auto. - Intros; Simpl. - Repeat Rewrite isacs_aux_ok. - Rewrite signed_sum_merge_ok. - Rewrite minus_sum_scalar_ok. - Rewrite H. - Rewrite (Th_distr_left T). - Rewrite (Th_opp_mult_left T). - Reflexivity. + intros; simpl in |- *. + repeat rewrite isacs_aux_ok. + rewrite signed_sum_merge_ok. + rewrite minus_sum_scalar_ok. + rewrite H. + rewrite (Th_distr_left T). + rewrite (Th_opp_mult_left T). + reflexivity. -Save. +Qed. -Theorem apolynomial_normalize_ok : (p:apolynomial) - (interp_sacs (apolynomial_normalize p))==(interp_ap p). +Theorem apolynomial_normalize_ok : + forall p:apolynomial, interp_sacs (apolynomial_normalize p) = interp_ap p. Proof. - Induction p; Simpl; Auto 1. - Intros. - Rewrite signed_sum_merge_ok. - Rewrite H; Rewrite H0; Reflexivity. - Intros. - Rewrite signed_sum_prod_ok. - Rewrite H; Rewrite H0; Reflexivity. - Intros. - Rewrite signed_sum_opp_ok. - Rewrite H; Reflexivity. -Save. - -End abstract_rings. + simple induction p; simpl in |- *; auto 1. + intros. + rewrite signed_sum_merge_ok. + rewrite H; rewrite H0; reflexivity. + intros. + rewrite signed_sum_prod_ok. + rewrite H; rewrite H0; reflexivity. + intros. + rewrite signed_sum_opp_ok. + rewrite H; reflexivity. +Qed. + +End abstract_rings.
\ No newline at end of file diff --git a/contrib/ring/Ring_normalize.v b/contrib/ring/Ring_normalize.v index 94ad71ffc..faa892ce5 100644 --- a/contrib/ring/Ring_normalize.v +++ b/contrib/ring/Ring_normalize.v @@ -8,19 +8,19 @@ (* $Id$ *) -Require Ring_theory. -Require Quote. +Require Import Ring_theory. +Require Import Quote. Set Implicit Arguments. -Lemma index_eq_prop: (n,m:index)(Is_true (index_eq n m)) -> n=m. +Lemma index_eq_prop : forall n m:index, Is_true (index_eq n m) -> n = m. Proof. - Intros. - Apply Quote.index_eq_prop. - Generalize H. - Case (index_eq n m); Simpl; Trivial; Intros. - Contradiction. -Save. + intros. + apply index_eq_prop. + generalize H. + case (index_eq n m); simpl in |- *; trivial; intros. + contradiction. +Qed. Section semi_rings. @@ -49,16 +49,14 @@ Variable Aeq : A -> A -> bool. (* varlist is isomorphic to (list var), but we built a special inductive for efficiency *) -Inductive varlist : Type := -| Nil_var : varlist -| Cons_var : index -> varlist -> varlist -. +Inductive varlist : Type := + | Nil_var : varlist + | Cons_var : index -> varlist -> varlist. -Inductive canonical_sum : Type := -| Nil_monom : canonical_sum -| Cons_monom : A -> varlist -> canonical_sum -> canonical_sum -| Cons_varlist : varlist -> canonical_sum -> canonical_sum -. +Inductive canonical_sum : Type := + | Nil_monom : canonical_sum + | Cons_monom : A -> varlist -> canonical_sum -> canonical_sum + | Cons_varlist : varlist -> canonical_sum -> canonical_sum. (* Order on monoms *) @@ -75,199 +73,203 @@ Inductive canonical_sum : Type := 4*x*y < 59*x*y*y*z *) -Fixpoint varlist_eq [x,y:varlist] : bool := - Cases x y of - | Nil_var Nil_var => true - | (Cons_var i xrest) (Cons_var j yrest) => - (andb (index_eq i j) (varlist_eq xrest yrest)) - | _ _ => false +Fixpoint varlist_eq (x y:varlist) {struct y} : bool := + match x, y with + | Nil_var, Nil_var => true + | Cons_var i xrest, Cons_var j yrest => + andb (index_eq i j) (varlist_eq xrest yrest) + | _, _ => false end. -Fixpoint varlist_lt [x,y:varlist] : bool := - Cases x y of - | Nil_var (Cons_var _ _) => true - | (Cons_var i xrest) (Cons_var j yrest) => - if (index_lt i j) then true - else (andb (index_eq i j) (varlist_lt xrest yrest)) - | _ _ => false +Fixpoint varlist_lt (x y:varlist) {struct y} : bool := + match x, y with + | Nil_var, Cons_var _ _ => true + | Cons_var i xrest, Cons_var j yrest => + if index_lt i j + then true + else andb (index_eq i j) (varlist_lt xrest yrest) + | _, _ => false end. (* merges two variables lists *) -Fixpoint varlist_merge [l1:varlist] : varlist -> varlist := - Cases l1 of - | (Cons_var v1 t1) => - Fix vm_aux {vm_aux [l2:varlist] : varlist := - Cases l2 of - | (Cons_var v2 t2) => - if (index_lt v1 v2) - then (Cons_var v1 (varlist_merge t1 l2)) - else (Cons_var v2 (vm_aux t2)) - | Nil_var => l1 - end} - | Nil_var => [l2]l2 +Fixpoint varlist_merge (l1:varlist) : varlist -> varlist := + match l1 with + | Cons_var v1 t1 => + (fix vm_aux (l2:varlist) : varlist := + match l2 with + | Cons_var v2 t2 => + if index_lt v1 v2 + then Cons_var v1 (varlist_merge t1 l2) + else Cons_var v2 (vm_aux t2) + | Nil_var => l1 + end) + | Nil_var => fun l2 => l2 end. (* returns the sum of two canonical sums *) -Fixpoint canonical_sum_merge [s1:canonical_sum] - : canonical_sum -> canonical_sum := -Cases s1 of -| (Cons_monom c1 l1 t1) => - Fix csm_aux{csm_aux[s2:canonical_sum] : canonical_sum := - Cases s2 of - | (Cons_monom c2 l2 t2) => - if (varlist_eq l1 l2) - then (Cons_monom (Aplus c1 c2) l1 - (canonical_sum_merge t1 t2)) - else if (varlist_lt l1 l2) - then (Cons_monom c1 l1 (canonical_sum_merge t1 s2)) - else (Cons_monom c2 l2 (csm_aux t2)) - | (Cons_varlist l2 t2) => - if (varlist_eq l1 l2) - then (Cons_monom (Aplus c1 Aone) l1 - (canonical_sum_merge t1 t2)) - else if (varlist_lt l1 l2) - then (Cons_monom c1 l1 (canonical_sum_merge t1 s2)) - else (Cons_varlist l2 (csm_aux t2)) - | Nil_monom => s1 - end} -| (Cons_varlist l1 t1) => - Fix csm_aux2{csm_aux2[s2:canonical_sum] : canonical_sum := - Cases s2 of - | (Cons_monom c2 l2 t2) => - if (varlist_eq l1 l2) - then (Cons_monom (Aplus Aone c2) l1 - (canonical_sum_merge t1 t2)) - else if (varlist_lt l1 l2) - then (Cons_varlist l1 (canonical_sum_merge t1 s2)) - else (Cons_monom c2 l2 (csm_aux2 t2)) - | (Cons_varlist l2 t2) => - if (varlist_eq l1 l2) - then (Cons_monom (Aplus Aone Aone) l1 - (canonical_sum_merge t1 t2)) - else if (varlist_lt l1 l2) - then (Cons_varlist l1 (canonical_sum_merge t1 s2)) - else (Cons_varlist l2 (csm_aux2 t2)) - | Nil_monom => s1 - end} -| Nil_monom => [s2]s2 -end. +Fixpoint canonical_sum_merge (s1:canonical_sum) : + canonical_sum -> canonical_sum := + match s1 with + | Cons_monom c1 l1 t1 => + (fix csm_aux (s2:canonical_sum) : canonical_sum := + match s2 with + | Cons_monom c2 l2 t2 => + if varlist_eq l1 l2 + then Cons_monom (Aplus c1 c2) l1 (canonical_sum_merge t1 t2) + else + if varlist_lt l1 l2 + then Cons_monom c1 l1 (canonical_sum_merge t1 s2) + else Cons_monom c2 l2 (csm_aux t2) + | Cons_varlist l2 t2 => + if varlist_eq l1 l2 + then Cons_monom (Aplus c1 Aone) l1 (canonical_sum_merge t1 t2) + else + if varlist_lt l1 l2 + then Cons_monom c1 l1 (canonical_sum_merge t1 s2) + else Cons_varlist l2 (csm_aux t2) + | Nil_monom => s1 + end) + | Cons_varlist l1 t1 => + (fix csm_aux2 (s2:canonical_sum) : canonical_sum := + match s2 with + | Cons_monom c2 l2 t2 => + if varlist_eq l1 l2 + then Cons_monom (Aplus Aone c2) l1 (canonical_sum_merge t1 t2) + else + if varlist_lt l1 l2 + then Cons_varlist l1 (canonical_sum_merge t1 s2) + else Cons_monom c2 l2 (csm_aux2 t2) + | Cons_varlist l2 t2 => + if varlist_eq l1 l2 + then Cons_monom (Aplus Aone Aone) l1 (canonical_sum_merge t1 t2) + else + if varlist_lt l1 l2 + then Cons_varlist l1 (canonical_sum_merge t1 s2) + else Cons_varlist l2 (csm_aux2 t2) + | Nil_monom => s1 + end) + | Nil_monom => fun s2 => s2 + end. (* Insertion of a monom in a canonical sum *) -Fixpoint monom_insert [c1:A; l1:varlist; s2 : canonical_sum] - : canonical_sum := - Cases s2 of - | (Cons_monom c2 l2 t2) => - if (varlist_eq l1 l2) - then (Cons_monom (Aplus c1 c2) l1 t2) - else if (varlist_lt l1 l2) - then (Cons_monom c1 l1 s2) - else (Cons_monom c2 l2 (monom_insert c1 l1 t2)) - | (Cons_varlist l2 t2) => - if (varlist_eq l1 l2) - then (Cons_monom (Aplus c1 Aone) l1 t2) - else if (varlist_lt l1 l2) - then (Cons_monom c1 l1 s2) - else (Cons_varlist l2 (monom_insert c1 l1 t2)) - | Nil_monom => (Cons_monom c1 l1 Nil_monom) +Fixpoint monom_insert (c1:A) (l1:varlist) (s2:canonical_sum) {struct s2} : + canonical_sum := + match s2 with + | Cons_monom c2 l2 t2 => + if varlist_eq l1 l2 + then Cons_monom (Aplus c1 c2) l1 t2 + else + if varlist_lt l1 l2 + then Cons_monom c1 l1 s2 + else Cons_monom c2 l2 (monom_insert c1 l1 t2) + | Cons_varlist l2 t2 => + if varlist_eq l1 l2 + then Cons_monom (Aplus c1 Aone) l1 t2 + else + if varlist_lt l1 l2 + then Cons_monom c1 l1 s2 + else Cons_varlist l2 (monom_insert c1 l1 t2) + | Nil_monom => Cons_monom c1 l1 Nil_monom end. -Fixpoint varlist_insert [l1:varlist; s2:canonical_sum] - : canonical_sum := - Cases s2 of - | (Cons_monom c2 l2 t2) => - if (varlist_eq l1 l2) - then (Cons_monom (Aplus Aone c2) l1 t2) - else if (varlist_lt l1 l2) - then (Cons_varlist l1 s2) - else (Cons_monom c2 l2 (varlist_insert l1 t2)) - | (Cons_varlist l2 t2) => - if (varlist_eq l1 l2) - then (Cons_monom (Aplus Aone Aone) l1 t2) - else if (varlist_lt l1 l2) - then (Cons_varlist l1 s2) - else (Cons_varlist l2 (varlist_insert l1 t2)) - | Nil_monom => (Cons_varlist l1 Nil_monom) +Fixpoint varlist_insert (l1:varlist) (s2:canonical_sum) {struct s2} : + canonical_sum := + match s2 with + | Cons_monom c2 l2 t2 => + if varlist_eq l1 l2 + then Cons_monom (Aplus Aone c2) l1 t2 + else + if varlist_lt l1 l2 + then Cons_varlist l1 s2 + else Cons_monom c2 l2 (varlist_insert l1 t2) + | Cons_varlist l2 t2 => + if varlist_eq l1 l2 + then Cons_monom (Aplus Aone Aone) l1 t2 + else + if varlist_lt l1 l2 + then Cons_varlist l1 s2 + else Cons_varlist l2 (varlist_insert l1 t2) + | Nil_monom => Cons_varlist l1 Nil_monom end. (* Computes c0*s *) -Fixpoint canonical_sum_scalar [c0:A; s:canonical_sum] : canonical_sum := - Cases s of - | (Cons_monom c l t) => - (Cons_monom (Amult c0 c) l (canonical_sum_scalar c0 t)) - | (Cons_varlist l t) => - (Cons_monom c0 l (canonical_sum_scalar c0 t)) - | Nil_monom => Nil_monom - end. +Fixpoint canonical_sum_scalar (c0:A) (s:canonical_sum) {struct s} : + canonical_sum := + match s with + | Cons_monom c l t => Cons_monom (Amult c0 c) l (canonical_sum_scalar c0 t) + | Cons_varlist l t => Cons_monom c0 l (canonical_sum_scalar c0 t) + | Nil_monom => Nil_monom + end. (* Computes l0*s *) -Fixpoint canonical_sum_scalar2 [l0:varlist; s:canonical_sum] - : canonical_sum := - Cases s of - | (Cons_monom c l t) => - (monom_insert c (varlist_merge l0 l) (canonical_sum_scalar2 l0 t)) - | (Cons_varlist l t) => - (varlist_insert (varlist_merge l0 l) (canonical_sum_scalar2 l0 t)) - | Nil_monom => Nil_monom - end. +Fixpoint canonical_sum_scalar2 (l0:varlist) (s:canonical_sum) {struct s} : + canonical_sum := + match s with + | Cons_monom c l t => + monom_insert c (varlist_merge l0 l) (canonical_sum_scalar2 l0 t) + | Cons_varlist l t => + varlist_insert (varlist_merge l0 l) (canonical_sum_scalar2 l0 t) + | Nil_monom => Nil_monom + end. (* Computes c0*l0*s *) -Fixpoint canonical_sum_scalar3 [c0:A;l0:varlist; s:canonical_sum] - : canonical_sum := - Cases s of - | (Cons_monom c l t) => - (monom_insert (Amult c0 c) (varlist_merge l0 l) - (canonical_sum_scalar3 c0 l0 t)) - | (Cons_varlist l t) => - (monom_insert c0 (varlist_merge l0 l) - (canonical_sum_scalar3 c0 l0 t)) - | Nil_monom => Nil_monom - end. +Fixpoint canonical_sum_scalar3 (c0:A) (l0:varlist) + (s:canonical_sum) {struct s} : canonical_sum := + match s with + | Cons_monom c l t => + monom_insert (Amult c0 c) (varlist_merge l0 l) + (canonical_sum_scalar3 c0 l0 t) + | Cons_varlist l t => + monom_insert c0 (varlist_merge l0 l) (canonical_sum_scalar3 c0 l0 t) + | Nil_monom => Nil_monom + end. (* returns the product of two canonical sums *) -Fixpoint canonical_sum_prod [s1:canonical_sum] - : canonical_sum -> canonical_sum := - [s2]Cases s1 of - | (Cons_monom c1 l1 t1) => - (canonical_sum_merge (canonical_sum_scalar3 c1 l1 s2) - (canonical_sum_prod t1 s2)) - | (Cons_varlist l1 t1) => - (canonical_sum_merge (canonical_sum_scalar2 l1 s2) - (canonical_sum_prod t1 s2)) - | Nil_monom => Nil_monom - end. +Fixpoint canonical_sum_prod (s1 s2:canonical_sum) {struct s1} : + canonical_sum := + match s1 with + | Cons_monom c1 l1 t1 => + canonical_sum_merge (canonical_sum_scalar3 c1 l1 s2) + (canonical_sum_prod t1 s2) + | Cons_varlist l1 t1 => + canonical_sum_merge (canonical_sum_scalar2 l1 s2) + (canonical_sum_prod t1 s2) + | Nil_monom => Nil_monom + end. (* The type to represent concrete semi-ring polynomials *) -Inductive Type spolynomial := - SPvar : index -> spolynomial -| SPconst : A -> spolynomial -| SPplus : spolynomial -> spolynomial -> spolynomial -| SPmult : spolynomial -> spolynomial -> spolynomial. - -Fixpoint spolynomial_normalize[p:spolynomial] : canonical_sum := - Cases p of - | (SPvar i) => (Cons_varlist (Cons_var i Nil_var) Nil_monom) - | (SPconst c) => (Cons_monom c Nil_var Nil_monom) - | (SPplus l r) => (canonical_sum_merge (spolynomial_normalize l) - (spolynomial_normalize r)) - | (SPmult l r) => (canonical_sum_prod (spolynomial_normalize l) - (spolynomial_normalize r)) +Inductive spolynomial : Type := + | SPvar : index -> spolynomial + | SPconst : A -> spolynomial + | SPplus : spolynomial -> spolynomial -> spolynomial + | SPmult : spolynomial -> spolynomial -> spolynomial. + +Fixpoint spolynomial_normalize (p:spolynomial) : canonical_sum := + match p with + | SPvar i => Cons_varlist (Cons_var i Nil_var) Nil_monom + | SPconst c => Cons_monom c Nil_var Nil_monom + | SPplus l r => + canonical_sum_merge (spolynomial_normalize l) (spolynomial_normalize r) + | SPmult l r => + canonical_sum_prod (spolynomial_normalize l) (spolynomial_normalize r) end. (* Deletion of useless 0 and 1 in canonical sums *) -Fixpoint canonical_sum_simplify [ s:canonical_sum] : canonical_sum := - Cases s of - | (Cons_monom c l t) => - if (Aeq c Azero) - then (canonical_sum_simplify t) - else if (Aeq c Aone) - then (Cons_varlist l (canonical_sum_simplify t)) - else (Cons_monom c l (canonical_sum_simplify t)) - | (Cons_varlist l t) => (Cons_varlist l (canonical_sum_simplify t)) +Fixpoint canonical_sum_simplify (s:canonical_sum) : canonical_sum := + match s with + | Cons_monom c l t => + if Aeq c Azero + then canonical_sum_simplify t + else + if Aeq c Aone + then Cons_varlist l (canonical_sum_simplify t) + else Cons_monom c l (canonical_sum_simplify t) + | Cons_varlist l t => Cons_varlist l (canonical_sum_simplify t) | Nil_monom => Nil_monom end. -Definition spolynomial_simplify := - [x:spolynomial](canonical_sum_simplify (spolynomial_normalize x)). +Definition spolynomial_simplify (x:spolynomial) := + canonical_sum_simplify (spolynomial_normalize x). (* End definitions. *) @@ -277,7 +279,7 @@ Definition spolynomial_simplify := acording to a certain variables map. Once again the choosen definition is generic and could be changed ****) -Variable vm : (varmap A). +Variable vm : varmap A. (* Interpretation of list of variables * [x1; ... ; xn ] is interpreted as (find v x1)* ... *(find v xn) @@ -285,50 +287,49 @@ Variable vm : (varmap A). * never occur. Since we want only to prove correctness theorems, which form * is : for any varmap and any spolynom ... this is a safe and pain-saving * choice *) -Definition interp_var [i:index] := (varmap_find Azero i vm). +Definition interp_var (i:index) := varmap_find Azero i vm. -(* Local *) Definition ivl_aux := Fix ivl_aux {ivl_aux[x:index; t:varlist] : A := - Cases t of - | Nil_var => (interp_var x) - | (Cons_var x' t') => (Amult (interp_var x) (ivl_aux x' t')) - end}. +(* Local *) Definition ivl_aux := + (fix ivl_aux (x:index) (t:varlist) {struct t} : A := + match t with + | Nil_var => interp_var x + | Cons_var x' t' => Amult (interp_var x) (ivl_aux x' t') + end). -Definition interp_vl := [l:varlist] - Cases l of +Definition interp_vl (l:varlist) := + match l with | Nil_var => Aone - | (Cons_var x t) => (ivl_aux x t) + | Cons_var x t => ivl_aux x t end. -(* Local *) Definition interp_m := [c:A][l:varlist] - Cases l of - | Nil_var => c - | (Cons_var x t) => - (Amult c (ivl_aux x t)) - end. +(* Local *) Definition interp_m (c:A) (l:varlist) := + match l with + | Nil_var => c + | Cons_var x t => Amult c (ivl_aux x t) + end. -(* Local *) Definition ics_aux := Fix ics_aux{ics_aux[a:A; s:canonical_sum] : A := - Cases s of - | Nil_monom => a - | (Cons_varlist l t) => (Aplus a (ics_aux (interp_vl l) t)) - | (Cons_monom c l t) => (Aplus a (ics_aux (interp_m c l) t)) - end}. +(* Local *) Definition ics_aux := + (fix ics_aux (a:A) (s:canonical_sum) {struct s} : A := + match s with + | Nil_monom => a + | Cons_varlist l t => Aplus a (ics_aux (interp_vl l) t) + | Cons_monom c l t => Aplus a (ics_aux (interp_m c l) t) + end). (* Interpretation of a canonical sum *) -Definition interp_cs : canonical_sum -> A := - [s]Cases s of +Definition interp_cs (s:canonical_sum) : A := + match s with | Nil_monom => Azero - | (Cons_varlist l t) => - (ics_aux (interp_vl l) t) - | (Cons_monom c l t) => - (ics_aux (interp_m c l) t) + | Cons_varlist l t => ics_aux (interp_vl l) t + | Cons_monom c l t => ics_aux (interp_m c l) t end. -Fixpoint interp_sp [p:spolynomial] : A := - Cases p of - (SPconst c) => c - | (SPvar i) => (interp_var i) - | (SPplus p1 p2) => (Aplus (interp_sp p1) (interp_sp p2)) - | (SPmult p1 p2) => (Amult (interp_sp p1) (interp_sp p2)) +Fixpoint interp_sp (p:spolynomial) : A := + match p with + | SPconst c => c + | SPvar i => interp_var i + | SPplus p1 p2 => Aplus (interp_sp p1) (interp_sp p2) + | SPmult p1 p2 => Amult (interp_sp p1) (interp_sp p2) end. @@ -338,415 +339,420 @@ Unset Implicit Arguments. (* Section properties. *) -Variable T : (Semi_Ring_Theory Aplus Amult Aone Azero Aeq). - -Hint SR_plus_sym_T := Resolve (SR_plus_sym T). -Hint SR_plus_assoc_T := Resolve (SR_plus_assoc T). -Hint SR_plus_assoc2_T := Resolve (SR_plus_assoc2 T). -Hint SR_mult_sym_T := Resolve (SR_mult_sym T). -Hint SR_mult_assoc_T := Resolve (SR_mult_assoc T). -Hint SR_mult_assoc2_T := Resolve (SR_mult_assoc2 T). -Hint SR_plus_zero_left_T := Resolve (SR_plus_zero_left T). -Hint SR_plus_zero_left2_T := Resolve (SR_plus_zero_left2 T). -Hint SR_mult_one_left_T := Resolve (SR_mult_one_left T). -Hint SR_mult_one_left2_T := Resolve (SR_mult_one_left2 T). -Hint SR_mult_zero_left_T := Resolve (SR_mult_zero_left T). -Hint SR_mult_zero_left2_T := Resolve (SR_mult_zero_left2 T). -Hint SR_distr_left_T := Resolve (SR_distr_left T). -Hint SR_distr_left2_T := Resolve (SR_distr_left2 T). -Hint SR_plus_reg_left_T := Resolve (SR_plus_reg_left T). -Hint SR_plus_permute_T := Resolve (SR_plus_permute T). -Hint SR_mult_permute_T := Resolve (SR_mult_permute T). -Hint SR_distr_right_T := Resolve (SR_distr_right T). -Hint SR_distr_right2_T := Resolve (SR_distr_right2 T). -Hint SR_mult_zero_right_T := Resolve (SR_mult_zero_right T). -Hint SR_mult_zero_right2_T := Resolve (SR_mult_zero_right2 T). -Hint SR_plus_zero_right_T := Resolve (SR_plus_zero_right T). -Hint SR_plus_zero_right2_T := Resolve (SR_plus_zero_right2 T). -Hint SR_mult_one_right_T := Resolve (SR_mult_one_right T). -Hint SR_mult_one_right2_T := Resolve (SR_mult_one_right2 T). -Hint SR_plus_reg_right_T := Resolve (SR_plus_reg_right T). -Hints Resolve refl_equal sym_equal trans_equal. +Variable T : Semi_Ring_Theory Aplus Amult Aone Azero Aeq. + +Hint Resolve (SR_plus_comm T). +Hint Resolve (SR_plus_assoc T). +Hint Resolve (SR_plus_assoc2 T). +Hint Resolve (SR_mult_comm T). +Hint Resolve (SR_mult_assoc T). +Hint Resolve (SR_mult_assoc2 T). +Hint Resolve (SR_plus_zero_left T). +Hint Resolve (SR_plus_zero_left2 T). +Hint Resolve (SR_mult_one_left T). +Hint Resolve (SR_mult_one_left2 T). +Hint Resolve (SR_mult_zero_left T). +Hint Resolve (SR_mult_zero_left2 T). +Hint Resolve (SR_distr_left T). +Hint Resolve (SR_distr_left2 T). +Hint Resolve (SR_plus_reg_left T). +Hint Resolve (SR_plus_permute T). +Hint Resolve (SR_mult_permute T). +Hint Resolve (SR_distr_right T). +Hint Resolve (SR_distr_right2 T). +Hint Resolve (SR_mult_zero_right T). +Hint Resolve (SR_mult_zero_right2 T). +Hint Resolve (SR_plus_zero_right T). +Hint Resolve (SR_plus_zero_right2 T). +Hint Resolve (SR_mult_one_right T). +Hint Resolve (SR_mult_one_right2 T). +Hint Resolve (SR_plus_reg_right T). +Hint Resolve refl_equal sym_equal trans_equal. (* Hints Resolve refl_eqT sym_eqT trans_eqT. *) -Hints Immediate T. +Hint Immediate T. -Lemma varlist_eq_prop : (x,y:varlist) - (Is_true (varlist_eq x y))->x==y. +Lemma varlist_eq_prop : forall x y:varlist, Is_true (varlist_eq x y) -> x = y. Proof. - Induction x; Induction y; Contradiction Orelse Try Reflexivity. - Simpl; Intros. - Generalize (andb_prop2 ? ? H1); Intros; Elim H2; Intros. - Rewrite (index_eq_prop H3); Rewrite (H v0 H4); Reflexivity. -Save. - -Remark ivl_aux_ok : (v:varlist)(i:index) - (ivl_aux i v)==(Amult (interp_var i) (interp_vl v)). + simple induction x; simple induction y; contradiction || (try reflexivity). + simpl in |- *; intros. + generalize (andb_prop2 _ _ H1); intros; elim H2; intros. + rewrite (index_eq_prop _ _ H3); rewrite (H v0 H4); reflexivity. +Qed. + +Remark ivl_aux_ok : + forall (v:varlist) (i:index), + ivl_aux i v = Amult (interp_var i) (interp_vl v). Proof. - Induction v; Simpl; Intros. - Trivial. - Rewrite H; Trivial. -Save. - -Lemma varlist_merge_ok : (x,y:varlist) - (interp_vl (varlist_merge x y)) - ==(Amult (interp_vl x) (interp_vl y)). + simple induction v; simpl in |- *; intros. + trivial. + rewrite H; trivial. +Qed. + +Lemma varlist_merge_ok : + forall x y:varlist, + interp_vl (varlist_merge x y) = Amult (interp_vl x) (interp_vl y). Proof. - Induction x. - Simpl; Trivial. - Induction y. - Simpl; Trivial. - Simpl; Intros. - Elim (index_lt i i0); Simpl; Intros. - - Repeat Rewrite ivl_aux_ok. - Rewrite H. Simpl. - Rewrite ivl_aux_ok. - EAuto. - - Repeat Rewrite ivl_aux_ok. - Rewrite H0. - Rewrite ivl_aux_ok. - EAuto. -Save. - -Remark ics_aux_ok : (x:A)(s:canonical_sum) - (ics_aux x s)==(Aplus x (interp_cs s)). + simple induction x. + simpl in |- *; trivial. + simple induction y. + simpl in |- *; trivial. + simpl in |- *; intros. + elim (index_lt i i0); simpl in |- *; intros. + + repeat rewrite ivl_aux_ok. + rewrite H. simpl in |- *. + rewrite ivl_aux_ok. + eauto. + + repeat rewrite ivl_aux_ok. + rewrite H0. + rewrite ivl_aux_ok. + eauto. +Qed. + +Remark ics_aux_ok : + forall (x:A) (s:canonical_sum), ics_aux x s = Aplus x (interp_cs s). Proof. - Induction s; Simpl; Intros. - Trivial. - Reflexivity. - Reflexivity. -Save. - -Remark interp_m_ok : (x:A)(l:varlist) - (interp_m x l)==(Amult x (interp_vl l)). + simple induction s; simpl in |- *; intros. + trivial. + reflexivity. + reflexivity. +Qed. + +Remark interp_m_ok : + forall (x:A) (l:varlist), interp_m x l = Amult x (interp_vl l). Proof. - NewDestruct l. - Simpl; Trivial. - Reflexivity. -Save. + destruct l as [| i v]. + simpl in |- *; trivial. + reflexivity. +Qed. -Lemma canonical_sum_merge_ok : (x,y:canonical_sum) - (interp_cs (canonical_sum_merge x y)) - ==(Aplus (interp_cs x) (interp_cs y)). +Lemma canonical_sum_merge_ok : + forall x y:canonical_sum, + interp_cs (canonical_sum_merge x y) = Aplus (interp_cs x) (interp_cs y). -Induction x; Simpl. -Trivial. +simple induction x; simpl in |- *. +trivial. -Induction y; Simpl; Intros. +simple induction y; simpl in |- *; intros. (* monom and nil *) -EAuto. +eauto. (* monom and monom *) -Generalize (varlist_eq_prop v v0). -Elim (varlist_eq v v0). -Intros; Rewrite (H1 I). -Simpl; Repeat Rewrite ics_aux_ok; Rewrite H. -Repeat Rewrite interp_m_ok. -Rewrite (SR_distr_left T). -Repeat Rewrite <- (SR_plus_assoc T). -Apply congr_eqT with f:=(Aplus (Amult a (interp_vl v0))). -Trivial. - -Elim (varlist_lt v v0); Simpl. -Repeat Rewrite ics_aux_ok. -Rewrite H; Simpl; Rewrite ics_aux_ok; EAuto. - -Rewrite ics_aux_ok; Rewrite H0; Repeat Rewrite ics_aux_ok; Simpl; EAuto. +generalize (varlist_eq_prop v v0). +elim (varlist_eq v v0). +intros; rewrite (H1 I). +simpl in |- *; repeat rewrite ics_aux_ok; rewrite H. +repeat rewrite interp_m_ok. +rewrite (SR_distr_left T). +repeat rewrite <- (SR_plus_assoc T). +apply f_equal with (f := Aplus (Amult a (interp_vl v0))). +trivial. + +elim (varlist_lt v v0); simpl in |- *. +repeat rewrite ics_aux_ok. +rewrite H; simpl in |- *; rewrite ics_aux_ok; eauto. + +rewrite ics_aux_ok; rewrite H0; repeat rewrite ics_aux_ok; simpl in |- *; + eauto. (* monom and varlist *) -Generalize (varlist_eq_prop v v0). -Elim (varlist_eq v v0). -Intros; Rewrite (H1 I). -Simpl; Repeat Rewrite ics_aux_ok; Rewrite H. -Repeat Rewrite interp_m_ok. -Rewrite (SR_distr_left T). -Repeat Rewrite <- (SR_plus_assoc T). -Apply congr_eqT with f:=(Aplus (Amult a (interp_vl v0))). -Rewrite (SR_mult_one_left T). -Trivial. - -Elim (varlist_lt v v0); Simpl. -Repeat Rewrite ics_aux_ok. -Rewrite H; Simpl; Rewrite ics_aux_ok; EAuto. -Rewrite ics_aux_ok; Rewrite H0; Repeat Rewrite ics_aux_ok; Simpl; EAuto. - -Induction y; Simpl; Intros. +generalize (varlist_eq_prop v v0). +elim (varlist_eq v v0). +intros; rewrite (H1 I). +simpl in |- *; repeat rewrite ics_aux_ok; rewrite H. +repeat rewrite interp_m_ok. +rewrite (SR_distr_left T). +repeat rewrite <- (SR_plus_assoc T). +apply f_equal with (f := Aplus (Amult a (interp_vl v0))). +rewrite (SR_mult_one_left T). +trivial. + +elim (varlist_lt v v0); simpl in |- *. +repeat rewrite ics_aux_ok. +rewrite H; simpl in |- *; rewrite ics_aux_ok; eauto. +rewrite ics_aux_ok; rewrite H0; repeat rewrite ics_aux_ok; simpl in |- *; + eauto. + +simple induction y; simpl in |- *; intros. (* varlist and nil *) -Trivial. +trivial. (* varlist and monom *) -Generalize (varlist_eq_prop v v0). -Elim (varlist_eq v v0). -Intros; Rewrite (H1 I). -Simpl; Repeat Rewrite ics_aux_ok; Rewrite H. -Repeat Rewrite interp_m_ok. -Rewrite (SR_distr_left T). -Repeat Rewrite <- (SR_plus_assoc T). -Rewrite (SR_mult_one_left T). -Apply congr_eqT with f:=(Aplus (interp_vl v0)). -Trivial. - -Elim (varlist_lt v v0); Simpl. -Repeat Rewrite ics_aux_ok. -Rewrite H; Simpl; Rewrite ics_aux_ok; EAuto. -Rewrite ics_aux_ok; Rewrite H0; Repeat Rewrite ics_aux_ok; Simpl; EAuto. +generalize (varlist_eq_prop v v0). +elim (varlist_eq v v0). +intros; rewrite (H1 I). +simpl in |- *; repeat rewrite ics_aux_ok; rewrite H. +repeat rewrite interp_m_ok. +rewrite (SR_distr_left T). +repeat rewrite <- (SR_plus_assoc T). +rewrite (SR_mult_one_left T). +apply f_equal with (f := Aplus (interp_vl v0)). +trivial. + +elim (varlist_lt v v0); simpl in |- *. +repeat rewrite ics_aux_ok. +rewrite H; simpl in |- *; rewrite ics_aux_ok; eauto. +rewrite ics_aux_ok; rewrite H0; repeat rewrite ics_aux_ok; simpl in |- *; + eauto. (* varlist and varlist *) -Generalize (varlist_eq_prop v v0). -Elim (varlist_eq v v0). -Intros; Rewrite (H1 I). -Simpl; Repeat Rewrite ics_aux_ok; Rewrite H. -Repeat Rewrite interp_m_ok. -Rewrite (SR_distr_left T). -Repeat Rewrite <- (SR_plus_assoc T). -Rewrite (SR_mult_one_left T). -Apply congr_eqT with f:=(Aplus (interp_vl v0)). -Trivial. - -Elim (varlist_lt v v0); Simpl. -Repeat Rewrite ics_aux_ok. -Rewrite H; Simpl; Rewrite ics_aux_ok; EAuto. -Rewrite ics_aux_ok; Rewrite H0; Repeat Rewrite ics_aux_ok; Simpl; EAuto. -Save. - -Lemma monom_insert_ok: (a:A)(l:varlist)(s:canonical_sum) - (interp_cs (monom_insert a l s)) - == (Aplus (Amult a (interp_vl l)) (interp_cs s)). -Intros; Generalize s; Induction s0. - -Simpl; Rewrite interp_m_ok; Trivial. - -Simpl; Intros. -Generalize (varlist_eq_prop l v); Elim (varlist_eq l v). -Intro Hr; Rewrite (Hr I); Simpl; Rewrite interp_m_ok; - Repeat Rewrite ics_aux_ok; Rewrite interp_m_ok; - Rewrite (SR_distr_left T); EAuto. -Elim (varlist_lt l v); Simpl; -[ Repeat Rewrite interp_m_ok; Rewrite ics_aux_ok; EAuto -| Repeat Rewrite interp_m_ok; Rewrite ics_aux_ok; - Rewrite H; Rewrite ics_aux_ok; EAuto]. - -Simpl; Intros. -Generalize (varlist_eq_prop l v); Elim (varlist_eq l v). -Intro Hr; Rewrite (Hr I); Simpl; Rewrite interp_m_ok; - Repeat Rewrite ics_aux_ok; - Rewrite (SR_distr_left T); Rewrite (SR_mult_one_left T); EAuto. -Elim (varlist_lt l v); Simpl; -[ Repeat Rewrite interp_m_ok; Rewrite ics_aux_ok; EAuto -| Repeat Rewrite interp_m_ok; Rewrite ics_aux_ok; - Rewrite H; Rewrite ics_aux_ok; EAuto]. -Save. +generalize (varlist_eq_prop v v0). +elim (varlist_eq v v0). +intros; rewrite (H1 I). +simpl in |- *; repeat rewrite ics_aux_ok; rewrite H. +repeat rewrite interp_m_ok. +rewrite (SR_distr_left T). +repeat rewrite <- (SR_plus_assoc T). +rewrite (SR_mult_one_left T). +apply f_equal with (f := Aplus (interp_vl v0)). +trivial. + +elim (varlist_lt v v0); simpl in |- *. +repeat rewrite ics_aux_ok. +rewrite H; simpl in |- *; rewrite ics_aux_ok; eauto. +rewrite ics_aux_ok; rewrite H0; repeat rewrite ics_aux_ok; simpl in |- *; + eauto. +Qed. + +Lemma monom_insert_ok : + forall (a:A) (l:varlist) (s:canonical_sum), + interp_cs (monom_insert a l s) = + Aplus (Amult a (interp_vl l)) (interp_cs s). +intros; generalize s; simple induction s0. + +simpl in |- *; rewrite interp_m_ok; trivial. + +simpl in |- *; intros. +generalize (varlist_eq_prop l v); elim (varlist_eq l v). +intro Hr; rewrite (Hr I); simpl in |- *; rewrite interp_m_ok; + repeat rewrite ics_aux_ok; rewrite interp_m_ok; rewrite (SR_distr_left T); + eauto. +elim (varlist_lt l v); simpl in |- *; + [ repeat rewrite interp_m_ok; rewrite ics_aux_ok; eauto + | repeat rewrite interp_m_ok; rewrite ics_aux_ok; rewrite H; + rewrite ics_aux_ok; eauto ]. + +simpl in |- *; intros. +generalize (varlist_eq_prop l v); elim (varlist_eq l v). +intro Hr; rewrite (Hr I); simpl in |- *; rewrite interp_m_ok; + repeat rewrite ics_aux_ok; rewrite (SR_distr_left T); + rewrite (SR_mult_one_left T); eauto. +elim (varlist_lt l v); simpl in |- *; + [ repeat rewrite interp_m_ok; rewrite ics_aux_ok; eauto + | repeat rewrite interp_m_ok; rewrite ics_aux_ok; rewrite H; + rewrite ics_aux_ok; eauto ]. +Qed. Lemma varlist_insert_ok : - (l:varlist)(s:canonical_sum) - (interp_cs (varlist_insert l s)) - == (Aplus (interp_vl l) (interp_cs s)). -Intros; Generalize s; Induction s0. - -Simpl; Trivial. - -Simpl; Intros. -Generalize (varlist_eq_prop l v); Elim (varlist_eq l v). -Intro Hr; Rewrite (Hr I); Simpl; Rewrite interp_m_ok; - Repeat Rewrite ics_aux_ok; Rewrite interp_m_ok; - Rewrite (SR_distr_left T); Rewrite (SR_mult_one_left T); EAuto. -Elim (varlist_lt l v); Simpl; -[ Repeat Rewrite interp_m_ok; Rewrite ics_aux_ok; EAuto -| Repeat Rewrite interp_m_ok; Rewrite ics_aux_ok; - Rewrite H; Rewrite ics_aux_ok; EAuto]. - -Simpl; Intros. -Generalize (varlist_eq_prop l v); Elim (varlist_eq l v). -Intro Hr; Rewrite (Hr I); Simpl; Rewrite interp_m_ok; - Repeat Rewrite ics_aux_ok; - Rewrite (SR_distr_left T); Rewrite (SR_mult_one_left T); EAuto. -Elim (varlist_lt l v); Simpl; -[ Repeat Rewrite interp_m_ok; Rewrite ics_aux_ok; EAuto -| Repeat Rewrite interp_m_ok; Rewrite ics_aux_ok; - Rewrite H; Rewrite ics_aux_ok; EAuto]. -Save. - -Lemma canonical_sum_scalar_ok : (a:A)(s:canonical_sum) - (interp_cs (canonical_sum_scalar a s)) - ==(Amult a (interp_cs s)). -Induction s. -Simpl; EAuto. - -Simpl; Intros. -Repeat Rewrite ics_aux_ok. -Repeat Rewrite interp_m_ok. -Rewrite H. -Rewrite (SR_distr_right T). -Repeat Rewrite <- (SR_mult_assoc T). -Reflexivity. - -Simpl; Intros. -Repeat Rewrite ics_aux_ok. -Repeat Rewrite interp_m_ok. -Rewrite H. -Rewrite (SR_distr_right T). -Repeat Rewrite <- (SR_mult_assoc T). -Reflexivity. -Save. - -Lemma canonical_sum_scalar2_ok : (l:varlist; s:canonical_sum) - (interp_cs (canonical_sum_scalar2 l s)) - ==(Amult (interp_vl l) (interp_cs s)). -Induction s. -Simpl; Trivial. - -Simpl; Intros. -Rewrite monom_insert_ok. -Repeat Rewrite ics_aux_ok. -Repeat Rewrite interp_m_ok. -Rewrite H. -Rewrite varlist_merge_ok. -Repeat Rewrite (SR_distr_right T). -Repeat Rewrite <- (SR_mult_assoc T). -Repeat Rewrite <- (SR_plus_assoc T). -Rewrite (SR_mult_permute T a (interp_vl l) (interp_vl v)). -Reflexivity. - -Simpl; Intros. -Rewrite varlist_insert_ok. -Repeat Rewrite ics_aux_ok. -Repeat Rewrite interp_m_ok. -Rewrite H. -Rewrite varlist_merge_ok. -Repeat Rewrite (SR_distr_right T). -Repeat Rewrite <- (SR_mult_assoc T). -Repeat Rewrite <- (SR_plus_assoc T). -Reflexivity. -Save. - -Lemma canonical_sum_scalar3_ok : (c:A; l:varlist; s:canonical_sum) - (interp_cs (canonical_sum_scalar3 c l s)) - ==(Amult c (Amult (interp_vl l) (interp_cs s))). -Induction s. -Simpl; Repeat Rewrite (SR_mult_zero_right T); Reflexivity. - -Simpl; Intros. -Rewrite monom_insert_ok. -Repeat Rewrite ics_aux_ok. -Repeat Rewrite interp_m_ok. -Rewrite H. -Rewrite varlist_merge_ok. -Repeat Rewrite (SR_distr_right T). -Repeat Rewrite <- (SR_mult_assoc T). -Repeat Rewrite <- (SR_plus_assoc T). -Rewrite (SR_mult_permute T a (interp_vl l) (interp_vl v)). -Reflexivity. - -Simpl; Intros. -Rewrite monom_insert_ok. -Repeat Rewrite ics_aux_ok. -Repeat Rewrite interp_m_ok. -Rewrite H. -Rewrite varlist_merge_ok. -Repeat Rewrite (SR_distr_right T). -Repeat Rewrite <- (SR_mult_assoc T). -Repeat Rewrite <- (SR_plus_assoc T). -Rewrite (SR_mult_permute T c (interp_vl l) (interp_vl v)). -Reflexivity. -Save. - -Lemma canonical_sum_prod_ok : (x,y:canonical_sum) - (interp_cs (canonical_sum_prod x y)) - ==(Amult (interp_cs x) (interp_cs y)). -Induction x; Simpl; Intros. -Trivial. - -Rewrite canonical_sum_merge_ok. -Rewrite canonical_sum_scalar3_ok. -Rewrite ics_aux_ok. -Rewrite interp_m_ok. -Rewrite H. -Rewrite (SR_mult_assoc T a (interp_vl v) (interp_cs y)). -Symmetry. -EAuto. - -Rewrite canonical_sum_merge_ok. -Rewrite canonical_sum_scalar2_ok. -Rewrite ics_aux_ok. -Rewrite H. -Trivial. -Save. - -Theorem spolynomial_normalize_ok : (p:spolynomial) - (interp_cs (spolynomial_normalize p)) == (interp_sp p). -Induction p; Simpl; Intros. - -Reflexivity. -Reflexivity. - -Rewrite canonical_sum_merge_ok. -Rewrite H; Rewrite H0. -Reflexivity. - -Rewrite canonical_sum_prod_ok. -Rewrite H; Rewrite H0. -Reflexivity. -Save. - -Lemma canonical_sum_simplify_ok : (s:canonical_sum) - (interp_cs (canonical_sum_simplify s)) == (interp_cs s). -Induction s. - -Reflexivity. + forall (l:varlist) (s:canonical_sum), + interp_cs (varlist_insert l s) = Aplus (interp_vl l) (interp_cs s). +intros; generalize s; simple induction s0. + +simpl in |- *; trivial. + +simpl in |- *; intros. +generalize (varlist_eq_prop l v); elim (varlist_eq l v). +intro Hr; rewrite (Hr I); simpl in |- *; rewrite interp_m_ok; + repeat rewrite ics_aux_ok; rewrite interp_m_ok; rewrite (SR_distr_left T); + rewrite (SR_mult_one_left T); eauto. +elim (varlist_lt l v); simpl in |- *; + [ repeat rewrite interp_m_ok; rewrite ics_aux_ok; eauto + | repeat rewrite interp_m_ok; rewrite ics_aux_ok; rewrite H; + rewrite ics_aux_ok; eauto ]. + +simpl in |- *; intros. +generalize (varlist_eq_prop l v); elim (varlist_eq l v). +intro Hr; rewrite (Hr I); simpl in |- *; rewrite interp_m_ok; + repeat rewrite ics_aux_ok; rewrite (SR_distr_left T); + rewrite (SR_mult_one_left T); eauto. +elim (varlist_lt l v); simpl in |- *; + [ repeat rewrite interp_m_ok; rewrite ics_aux_ok; eauto + | repeat rewrite interp_m_ok; rewrite ics_aux_ok; rewrite H; + rewrite ics_aux_ok; eauto ]. +Qed. + +Lemma canonical_sum_scalar_ok : + forall (a:A) (s:canonical_sum), + interp_cs (canonical_sum_scalar a s) = Amult a (interp_cs s). +simple induction s. +simpl in |- *; eauto. + +simpl in |- *; intros. +repeat rewrite ics_aux_ok. +repeat rewrite interp_m_ok. +rewrite H. +rewrite (SR_distr_right T). +repeat rewrite <- (SR_mult_assoc T). +reflexivity. + +simpl in |- *; intros. +repeat rewrite ics_aux_ok. +repeat rewrite interp_m_ok. +rewrite H. +rewrite (SR_distr_right T). +repeat rewrite <- (SR_mult_assoc T). +reflexivity. +Qed. + +Lemma canonical_sum_scalar2_ok : + forall (l:varlist) (s:canonical_sum), + interp_cs (canonical_sum_scalar2 l s) = Amult (interp_vl l) (interp_cs s). +simple induction s. +simpl in |- *; trivial. + +simpl in |- *; intros. +rewrite monom_insert_ok. +repeat rewrite ics_aux_ok. +repeat rewrite interp_m_ok. +rewrite H. +rewrite varlist_merge_ok. +repeat rewrite (SR_distr_right T). +repeat rewrite <- (SR_mult_assoc T). +repeat rewrite <- (SR_plus_assoc T). +rewrite (SR_mult_permute T a (interp_vl l) (interp_vl v)). +reflexivity. + +simpl in |- *; intros. +rewrite varlist_insert_ok. +repeat rewrite ics_aux_ok. +repeat rewrite interp_m_ok. +rewrite H. +rewrite varlist_merge_ok. +repeat rewrite (SR_distr_right T). +repeat rewrite <- (SR_mult_assoc T). +repeat rewrite <- (SR_plus_assoc T). +reflexivity. +Qed. + +Lemma canonical_sum_scalar3_ok : + forall (c:A) (l:varlist) (s:canonical_sum), + interp_cs (canonical_sum_scalar3 c l s) = + Amult c (Amult (interp_vl l) (interp_cs s)). +simple induction s. +simpl in |- *; repeat rewrite (SR_mult_zero_right T); reflexivity. + +simpl in |- *; intros. +rewrite monom_insert_ok. +repeat rewrite ics_aux_ok. +repeat rewrite interp_m_ok. +rewrite H. +rewrite varlist_merge_ok. +repeat rewrite (SR_distr_right T). +repeat rewrite <- (SR_mult_assoc T). +repeat rewrite <- (SR_plus_assoc T). +rewrite (SR_mult_permute T a (interp_vl l) (interp_vl v)). +reflexivity. + +simpl in |- *; intros. +rewrite monom_insert_ok. +repeat rewrite ics_aux_ok. +repeat rewrite interp_m_ok. +rewrite H. +rewrite varlist_merge_ok. +repeat rewrite (SR_distr_right T). +repeat rewrite <- (SR_mult_assoc T). +repeat rewrite <- (SR_plus_assoc T). +rewrite (SR_mult_permute T c (interp_vl l) (interp_vl v)). +reflexivity. +Qed. + +Lemma canonical_sum_prod_ok : + forall x y:canonical_sum, + interp_cs (canonical_sum_prod x y) = Amult (interp_cs x) (interp_cs y). +simple induction x; simpl in |- *; intros. +trivial. + +rewrite canonical_sum_merge_ok. +rewrite canonical_sum_scalar3_ok. +rewrite ics_aux_ok. +rewrite interp_m_ok. +rewrite H. +rewrite (SR_mult_assoc T a (interp_vl v) (interp_cs y)). +symmetry in |- *. +eauto. + +rewrite canonical_sum_merge_ok. +rewrite canonical_sum_scalar2_ok. +rewrite ics_aux_ok. +rewrite H. +trivial. +Qed. + +Theorem spolynomial_normalize_ok : + forall p:spolynomial, interp_cs (spolynomial_normalize p) = interp_sp p. +simple induction p; simpl in |- *; intros. + +reflexivity. +reflexivity. + +rewrite canonical_sum_merge_ok. +rewrite H; rewrite H0. +reflexivity. + +rewrite canonical_sum_prod_ok. +rewrite H; rewrite H0. +reflexivity. +Qed. + +Lemma canonical_sum_simplify_ok : + forall s:canonical_sum, interp_cs (canonical_sum_simplify s) = interp_cs s. +simple induction s. + +reflexivity. (* cons_monom *) -Simpl; Intros. -Generalize (SR_eq_prop T 8!a 9!Azero). -Elim (Aeq a Azero). -Intro Heq; Rewrite (Heq I). -Rewrite H. -Rewrite ics_aux_ok. -Rewrite interp_m_ok. -Rewrite (SR_mult_zero_left T). -Trivial. - -Intros; Simpl. -Generalize (SR_eq_prop T 8!a 9!Aone). -Elim (Aeq a Aone). -Intro Heq; Rewrite (Heq I). -Simpl. -Repeat Rewrite ics_aux_ok. -Rewrite interp_m_ok. -Rewrite H. -Rewrite (SR_mult_one_left T). -Reflexivity. - -Simpl. -Repeat Rewrite ics_aux_ok. -Rewrite interp_m_ok. -Rewrite H. -Reflexivity. +simpl in |- *; intros. +generalize (SR_eq_prop T a Azero). +elim (Aeq a Azero). +intro Heq; rewrite (Heq I). +rewrite H. +rewrite ics_aux_ok. +rewrite interp_m_ok. +rewrite (SR_mult_zero_left T). +trivial. + +intros; simpl in |- *. +generalize (SR_eq_prop T a Aone). +elim (Aeq a Aone). +intro Heq; rewrite (Heq I). +simpl in |- *. +repeat rewrite ics_aux_ok. +rewrite interp_m_ok. +rewrite H. +rewrite (SR_mult_one_left T). +reflexivity. + +simpl in |- *. +repeat rewrite ics_aux_ok. +rewrite interp_m_ok. +rewrite H. +reflexivity. (* cons_varlist *) -Simpl; Intros. -Repeat Rewrite ics_aux_ok. -Rewrite H. -Reflexivity. +simpl in |- *; intros. +repeat rewrite ics_aux_ok. +rewrite H. +reflexivity. -Save. +Qed. -Theorem spolynomial_simplify_ok : (p:spolynomial) - (interp_cs (spolynomial_simplify p)) == (interp_sp p). -Intro. -Unfold spolynomial_simplify. -Rewrite canonical_sum_simplify_ok. -Apply spolynomial_normalize_ok. -Save. +Theorem spolynomial_simplify_ok : + forall p:spolynomial, interp_cs (spolynomial_simplify p) = interp_sp p. +intro. +unfold spolynomial_simplify in |- *. +rewrite canonical_sum_simplify_ok. +apply spolynomial_normalize_ok. +Qed. (* End properties. *) End semi_rings. -Implicits Cons_varlist. -Implicits Cons_monom. -Implicits SPconst. -Implicits SPplus. -Implicits SPmult. +Implicit Arguments Cons_varlist. +Implicit Arguments Cons_monom. +Implicit Arguments SPconst. +Implicit Arguments SPplus. +Implicit Arguments SPmult. Section rings. @@ -761,133 +767,135 @@ Variable Aone : A. Variable Azero : A. Variable Aopp : A -> A. Variable Aeq : A -> A -> bool. -Variable vm : (varmap A). -Variable T : (Ring_Theory Aplus Amult Aone Azero Aopp Aeq). - -Hint Th_plus_sym_T := Resolve (Th_plus_sym T). -Hint Th_plus_assoc_T := Resolve (Th_plus_assoc T). -Hint Th_plus_assoc2_T := Resolve (Th_plus_assoc2 T). -Hint Th_mult_sym_T := Resolve (Th_mult_sym T). -Hint Th_mult_assoc_T := Resolve (Th_mult_assoc T). -Hint Th_mult_assoc2_T := Resolve (Th_mult_assoc2 T). -Hint Th_plus_zero_left_T := Resolve (Th_plus_zero_left T). -Hint Th_plus_zero_left2_T := Resolve (Th_plus_zero_left2 T). -Hint Th_mult_one_left_T := Resolve (Th_mult_one_left T). -Hint Th_mult_one_left2_T := Resolve (Th_mult_one_left2 T). -Hint Th_mult_zero_left_T := Resolve (Th_mult_zero_left T). -Hint Th_mult_zero_left2_T := Resolve (Th_mult_zero_left2 T). -Hint Th_distr_left_T := Resolve (Th_distr_left T). -Hint Th_distr_left2_T := Resolve (Th_distr_left2 T). -Hint Th_plus_reg_left_T := Resolve (Th_plus_reg_left T). -Hint Th_plus_permute_T := Resolve (Th_plus_permute T). -Hint Th_mult_permute_T := Resolve (Th_mult_permute T). -Hint Th_distr_right_T := Resolve (Th_distr_right T). -Hint Th_distr_right2_T := Resolve (Th_distr_right2 T). -Hint Th_mult_zero_right_T := Resolve (Th_mult_zero_right T). -Hint Th_mult_zero_right2_T := Resolve (Th_mult_zero_right2 T). -Hint Th_plus_zero_right_T := Resolve (Th_plus_zero_right T). -Hint Th_plus_zero_right2_T := Resolve (Th_plus_zero_right2 T). -Hint Th_mult_one_right_T := Resolve (Th_mult_one_right T). -Hint Th_mult_one_right2_T := Resolve (Th_mult_one_right2 T). -Hint Th_plus_reg_right_T := Resolve (Th_plus_reg_right T). -Hints Resolve refl_equal sym_equal trans_equal. +Variable vm : varmap A. +Variable T : Ring_Theory Aplus Amult Aone Azero Aopp Aeq. + +Hint Resolve (Th_plus_comm T). +Hint Resolve (Th_plus_assoc T). +Hint Resolve (Th_plus_assoc2 T). +Hint Resolve (Th_mult_sym T). +Hint Resolve (Th_mult_assoc T). +Hint Resolve (Th_mult_assoc2 T). +Hint Resolve (Th_plus_zero_left T). +Hint Resolve (Th_plus_zero_left2 T). +Hint Resolve (Th_mult_one_left T). +Hint Resolve (Th_mult_one_left2 T). +Hint Resolve (Th_mult_zero_left T). +Hint Resolve (Th_mult_zero_left2 T). +Hint Resolve (Th_distr_left T). +Hint Resolve (Th_distr_left2 T). +Hint Resolve (Th_plus_reg_left T). +Hint Resolve (Th_plus_permute T). +Hint Resolve (Th_mult_permute T). +Hint Resolve (Th_distr_right T). +Hint Resolve (Th_distr_right2 T). +Hint Resolve (Th_mult_zero_right T). +Hint Resolve (Th_mult_zero_right2 T). +Hint Resolve (Th_plus_zero_right T). +Hint Resolve (Th_plus_zero_right2 T). +Hint Resolve (Th_mult_one_right T). +Hint Resolve (Th_mult_one_right2 T). +Hint Resolve (Th_plus_reg_right T). +Hint Resolve refl_equal sym_equal trans_equal. (*Hints Resolve refl_eqT sym_eqT trans_eqT.*) -Hints Immediate T. +Hint Immediate T. (*** Definitions *) -Inductive Type polynomial := - Pvar : index -> polynomial -| Pconst : A -> polynomial -| Pplus : polynomial -> polynomial -> polynomial -| Pmult : polynomial -> polynomial -> polynomial -| Popp : polynomial -> polynomial. - -Fixpoint polynomial_normalize [x:polynomial] : (canonical_sum A) := - Cases x of - (Pplus l r) => (canonical_sum_merge Aplus Aone - (polynomial_normalize l) - (polynomial_normalize r)) - | (Pmult l r) => (canonical_sum_prod Aplus Amult Aone - (polynomial_normalize l) - (polynomial_normalize r)) - | (Pconst c) => (Cons_monom c Nil_var (Nil_monom A)) - | (Pvar i) => (Cons_varlist (Cons_var i Nil_var) (Nil_monom A)) - | (Popp p) => (canonical_sum_scalar3 Aplus Amult Aone - (Aopp Aone) Nil_var - (polynomial_normalize p)) +Inductive polynomial : Type := + | Pvar : index -> polynomial + | Pconst : A -> polynomial + | Pplus : polynomial -> polynomial -> polynomial + | Pmult : polynomial -> polynomial -> polynomial + | Popp : polynomial -> polynomial. + +Fixpoint polynomial_normalize (x:polynomial) : canonical_sum A := + match x with + | Pplus l r => + canonical_sum_merge Aplus Aone (polynomial_normalize l) + (polynomial_normalize r) + | Pmult l r => + canonical_sum_prod Aplus Amult Aone (polynomial_normalize l) + (polynomial_normalize r) + | Pconst c => Cons_monom c Nil_var (Nil_monom A) + | Pvar i => Cons_varlist (Cons_var i Nil_var) (Nil_monom A) + | Popp p => + canonical_sum_scalar3 Aplus Amult Aone (Aopp Aone) Nil_var + (polynomial_normalize p) end. -Definition polynomial_simplify := - [x:polynomial](canonical_sum_simplify Aone Azero Aeq - (polynomial_normalize x)). - -Fixpoint spolynomial_of [x:polynomial] : (spolynomial A) := - Cases x of - (Pplus l r) => (SPplus (spolynomial_of l) (spolynomial_of r)) - | (Pmult l r) => (SPmult (spolynomial_of l) (spolynomial_of r)) - | (Pconst c) => (SPconst c) - | (Pvar i) => (SPvar A i) - | (Popp p) => (SPmult (SPconst (Aopp Aone)) (spolynomial_of p)) +Definition polynomial_simplify (x:polynomial) := + canonical_sum_simplify Aone Azero Aeq (polynomial_normalize x). + +Fixpoint spolynomial_of (x:polynomial) : spolynomial A := + match x with + | Pplus l r => SPplus (spolynomial_of l) (spolynomial_of r) + | Pmult l r => SPmult (spolynomial_of l) (spolynomial_of r) + | Pconst c => SPconst c + | Pvar i => SPvar A i + | Popp p => SPmult (SPconst (Aopp Aone)) (spolynomial_of p) end. (*** Interpretation *) -Fixpoint interp_p [p:polynomial] : A := - Cases p of - (Pconst c) => c - | (Pvar i) => (varmap_find Azero i vm) - | (Pplus p1 p2) => (Aplus (interp_p p1) (interp_p p2)) - | (Pmult p1 p2) => (Amult (interp_p p1) (interp_p p2)) - | (Popp p1) => (Aopp (interp_p p1)) +Fixpoint interp_p (p:polynomial) : A := + match p with + | Pconst c => c + | Pvar i => varmap_find Azero i vm + | Pplus p1 p2 => Aplus (interp_p p1) (interp_p p2) + | Pmult p1 p2 => Amult (interp_p p1) (interp_p p2) + | Popp p1 => Aopp (interp_p p1) end. (*** Properties *) Unset Implicit Arguments. -Lemma spolynomial_of_ok : (p:polynomial) - (interp_p p)==(interp_sp Aplus Amult Azero vm (spolynomial_of p)). -Induction p; Reflexivity Orelse (Simpl; Intros). -Rewrite H; Rewrite H0; Reflexivity. -Rewrite H; Rewrite H0; Reflexivity. -Rewrite H. -Rewrite (Th_opp_mult_left2 T). -Rewrite (Th_mult_one_left T). -Reflexivity. -Save. - -Theorem polynomial_normalize_ok : (p:polynomial) - (polynomial_normalize p) - ==(spolynomial_normalize Aplus Amult Aone (spolynomial_of p)). -Induction p; Reflexivity Orelse (Simpl; Intros). -Rewrite H; Rewrite H0; Reflexivity. -Rewrite H; Rewrite H0; Reflexivity. -Rewrite H; Simpl. -Elim (canonical_sum_scalar3 Aplus Amult Aone (Aopp Aone) Nil_var - (spolynomial_normalize Aplus Amult Aone (spolynomial_of p0))); -[ Reflexivity -| Simpl; Intros; Rewrite H0; Reflexivity -| Simpl; Intros; Rewrite H0; Reflexivity ]. -Save. - -Theorem polynomial_simplify_ok : (p:polynomial) - (interp_cs Aplus Amult Aone Azero vm (polynomial_simplify p)) - ==(interp_p p). -Intro. -Unfold polynomial_simplify. -Rewrite spolynomial_of_ok. -Rewrite polynomial_normalize_ok. -Rewrite (canonical_sum_simplify_ok A Aplus Amult Aone Azero Aeq vm T). -Rewrite (spolynomial_normalize_ok A Aplus Amult Aone Azero Aeq vm T). -Reflexivity. -Save. +Lemma spolynomial_of_ok : + forall p:polynomial, + interp_p p = interp_sp Aplus Amult Azero vm (spolynomial_of p). +simple induction p; reflexivity || (simpl in |- *; intros). +rewrite H; rewrite H0; reflexivity. +rewrite H; rewrite H0; reflexivity. +rewrite H. +rewrite (Th_opp_mult_left2 T). +rewrite (Th_mult_one_left T). +reflexivity. +Qed. + +Theorem polynomial_normalize_ok : + forall p:polynomial, + polynomial_normalize p = + spolynomial_normalize Aplus Amult Aone (spolynomial_of p). +simple induction p; reflexivity || (simpl in |- *; intros). +rewrite H; rewrite H0; reflexivity. +rewrite H; rewrite H0; reflexivity. +rewrite H; simpl in |- *. +elim + (canonical_sum_scalar3 Aplus Amult Aone (Aopp Aone) Nil_var + (spolynomial_normalize Aplus Amult Aone (spolynomial_of p0))); + [ reflexivity + | simpl in |- *; intros; rewrite H0; reflexivity + | simpl in |- *; intros; rewrite H0; reflexivity ]. +Qed. + +Theorem polynomial_simplify_ok : + forall p:polynomial, + interp_cs Aplus Amult Aone Azero vm (polynomial_simplify p) = interp_p p. +intro. +unfold polynomial_simplify in |- *. +rewrite spolynomial_of_ok. +rewrite polynomial_normalize_ok. +rewrite (canonical_sum_simplify_ok A Aplus Amult Aone Azero Aeq vm T). +rewrite (spolynomial_normalize_ok A Aplus Amult Aone Azero Aeq vm T). +reflexivity. +Qed. End rings. -V8Infix "+" Pplus : ring_scope. -V8Infix "*" Pmult : ring_scope. -V8Notation "- x" := (Popp x) : ring_scope. -V8Notation "[ x ]" := (Pvar x) (at level 1) : ring_scope. +Infix "+" := Pplus : ring_scope. +Infix "*" := Pmult : ring_scope. +Notation "- x" := (Popp x) : ring_scope. +Notation "[ x ]" := (Pvar x) (at level 1) : ring_scope. -Delimits Scope ring_scope with ring. +Delimit Scope ring_scope with ring.
\ No newline at end of file diff --git a/contrib/ring/Ring_theory.v b/contrib/ring/Ring_theory.v index ddc52f812..c99cf3c4a 100644 --- a/contrib/ring/Ring_theory.v +++ b/contrib/ring/Ring_theory.v @@ -25,112 +25,110 @@ Variable Azero : A. is a good choice. The proof of A_eq_prop is in this case easy. *) Variable Aeq : A -> A -> bool. -Infix 4 "+" Aplus V8only 50 (left associativity). -Infix 4 "*" Amult V8only 40 (left associativity). +Infix "+" := Aplus (at level 50, left associativity). +Infix "*" := Amult (at level 40, left associativity). Notation "0" := Azero. Notation "1" := Aone. -Record Semi_Ring_Theory : Prop := -{ SR_plus_sym : (n,m:A) n + m == m + n; - SR_plus_assoc : (n,m,p:A) n + (m + p) == (n + m) + p; - SR_mult_sym : (n,m:A) n*m == m*n; - SR_mult_assoc : (n,m,p:A) n*(m*p) == (n*m)*p; - SR_plus_zero_left :(n:A) 0 + n == n; - SR_mult_one_left : (n:A) 1*n == n; - SR_mult_zero_left : (n:A) 0*n == 0; - SR_distr_left : (n,m,p:A) (n + m)*p == n*p + m*p; - SR_plus_reg_left : (n,m,p:A) n + m == n + p -> m==p; - SR_eq_prop : (x,y:A) (Is_true (Aeq x y)) -> x==y -}. +Record Semi_Ring_Theory : Prop := + {SR_plus_comm : forall n m:A, n + m = m + n; + SR_plus_assoc : forall n m p:A, n + (m + p) = n + m + p; + SR_mult_comm : forall n m:A, n * m = m * n; + SR_mult_assoc : forall n m p:A, n * (m * p) = n * m * p; + SR_plus_zero_left : forall n:A, 0 + n = n; + SR_mult_one_left : forall n:A, 1 * n = n; + SR_mult_zero_left : forall n:A, 0 * n = 0; + SR_distr_left : forall n m p:A, (n + m) * p = n * p + m * p; + SR_plus_reg_left : forall n m p:A, n + m = n + p -> m = p; + SR_eq_prop : forall x y:A, Is_true (Aeq x y) -> x = y}. Variable T : Semi_Ring_Theory. -Local plus_sym := (SR_plus_sym T). -Local plus_assoc := (SR_plus_assoc T). -Local mult_sym := ( SR_mult_sym T). -Local mult_assoc := (SR_mult_assoc T). -Local plus_zero_left := (SR_plus_zero_left T). -Local mult_one_left := (SR_mult_one_left T). -Local mult_zero_left := (SR_mult_zero_left T). -Local distr_left := (SR_distr_left T). -Local plus_reg_left := (SR_plus_reg_left T). +Let plus_comm := SR_plus_comm T. +Let plus_assoc := SR_plus_assoc T. +Let mult_comm := SR_mult_comm T. +Let mult_assoc := SR_mult_assoc T. +Let plus_zero_left := SR_plus_zero_left T. +Let mult_one_left := SR_mult_one_left T. +Let mult_zero_left := SR_mult_zero_left T. +Let distr_left := SR_distr_left T. +Let plus_reg_left := SR_plus_reg_left T. -Hints Resolve plus_sym plus_assoc mult_sym mult_assoc - plus_zero_left mult_one_left mult_zero_left distr_left - plus_reg_left. +Hint Resolve plus_comm plus_assoc mult_comm mult_assoc plus_zero_left + mult_one_left mult_zero_left distr_left plus_reg_left. (* Lemmas whose form is x=y are also provided in form y=x because Auto does not symmetry *) -Lemma SR_mult_assoc2 : (n,m,p:A) (n * m) * p == n * (m * p). -Symmetry; EAuto. Qed. +Lemma SR_mult_assoc2 : forall n m p:A, n * m * p = n * (m * p). +symmetry in |- *; eauto. Qed. -Lemma SR_plus_assoc2 : (n,m,p:A) (n + m) + p == n + (m + p). -Symmetry; EAuto. Qed. +Lemma SR_plus_assoc2 : forall n m p:A, n + m + p = n + (m + p). +symmetry in |- *; eauto. Qed. -Lemma SR_plus_zero_left2 : (n:A) n == 0 + n. -Symmetry; EAuto. Qed. +Lemma SR_plus_zero_left2 : forall n:A, n = 0 + n. +symmetry in |- *; eauto. Qed. -Lemma SR_mult_one_left2 : (n:A) n == 1*n. -Symmetry; EAuto. Qed. +Lemma SR_mult_one_left2 : forall n:A, n = 1 * n. +symmetry in |- *; eauto. Qed. -Lemma SR_mult_zero_left2 : (n:A) 0 == 0*n. -Symmetry; EAuto. Qed. +Lemma SR_mult_zero_left2 : forall n:A, 0 = 0 * n. +symmetry in |- *; eauto. Qed. -Lemma SR_distr_left2 : (n,m,p:A) n*p + m*p == (n + m)*p. -Symmetry; EAuto. Qed. +Lemma SR_distr_left2 : forall n m p:A, n * p + m * p = (n + m) * p. +symmetry in |- *; eauto. Qed. -Lemma SR_plus_permute : (n,m,p:A) n + (m + p) == m + (n + p). -Intros. -Rewrite -> plus_assoc. -Elim (plus_sym m n). -Rewrite <- plus_assoc. -Reflexivity. +Lemma SR_plus_permute : forall n m p:A, n + (m + p) = m + (n + p). +intros. +rewrite plus_assoc. +elim (plus_comm m n). +rewrite <- plus_assoc. +reflexivity. Qed. -Lemma SR_mult_permute : (n,m,p:A) n*(m*p) == m*(n*p). -Intros. -Rewrite -> mult_assoc. -Elim (mult_sym m n). -Rewrite <- mult_assoc. -Reflexivity. +Lemma SR_mult_permute : forall n m p:A, n * (m * p) = m * (n * p). +intros. +rewrite mult_assoc. +elim (mult_comm m n). +rewrite <- mult_assoc. +reflexivity. Qed. -Hints Resolve SR_plus_permute SR_mult_permute. +Hint Resolve SR_plus_permute SR_mult_permute. -Lemma SR_distr_right : (n,m,p:A) n*(m + p) == (n*m) + (n*p). -Intros. -Repeat Rewrite -> (mult_sym n). -EAuto. +Lemma SR_distr_right : forall n m p:A, n * (m + p) = n * m + n * p. +intros. +repeat rewrite (mult_comm n). +eauto. Qed. -Lemma SR_distr_right2 : (n,m,p:A) (n*m) + (n*p) == n*(m + p). -Symmetry; Apply SR_distr_right. Qed. +Lemma SR_distr_right2 : forall n m p:A, n * m + n * p = n * (m + p). +symmetry in |- *; apply SR_distr_right. Qed. -Lemma SR_mult_zero_right : (n:A) n*0 == 0. -Intro; Rewrite mult_sym; EAuto. +Lemma SR_mult_zero_right : forall n:A, n * 0 = 0. +intro; rewrite mult_comm; eauto. Qed. -Lemma SR_mult_zero_right2 : (n:A) 0 == n*0. -Intro; Rewrite mult_sym; EAuto. +Lemma SR_mult_zero_right2 : forall n:A, 0 = n * 0. +intro; rewrite mult_comm; eauto. Qed. -Lemma SR_plus_zero_right :(n:A) n + 0 == n. -Intro; Rewrite plus_sym; EAuto. +Lemma SR_plus_zero_right : forall n:A, n + 0 = n. +intro; rewrite plus_comm; eauto. Qed. -Lemma SR_plus_zero_right2 :(n:A) n == n + 0. -Intro; Rewrite plus_sym; EAuto. +Lemma SR_plus_zero_right2 : forall n:A, n = n + 0. +intro; rewrite plus_comm; eauto. Qed. -Lemma SR_mult_one_right : (n:A) n*1 == n. -Intro; Elim mult_sym; Auto. +Lemma SR_mult_one_right : forall n:A, n * 1 = n. +intro; elim mult_comm; auto. Qed. -Lemma SR_mult_one_right2 : (n:A) n == n*1. -Intro; Elim mult_sym; Auto. +Lemma SR_mult_one_right2 : forall n:A, n = n * 1. +intro; elim mult_comm; auto. Qed. -Lemma SR_plus_reg_right : (n,m,p:A) m + n == p + n -> m==p. -Intros n m p; Rewrite (plus_sym m n); Rewrite (plus_sym p n); EAuto. +Lemma SR_plus_reg_right : forall n m p:A, m + n = p + n -> m = p. +intros n m p; rewrite (plus_comm m n); rewrite (plus_comm p n); eauto. Qed. End Theory_of_semi_rings. @@ -146,228 +144,222 @@ Variable Azero : A. Variable Aopp : A -> A. Variable Aeq : A -> A -> bool. -Infix 4 "+" Aplus V8only 50 (left associativity). -Infix 4 "*" Amult V8only 40 (left associativity). +Infix "+" := Aplus (at level 50, left associativity). +Infix "*" := Amult (at level 40, left associativity). Notation "0" := Azero. Notation "1" := Aone. -Notation "- x" := (Aopp x) (at level 0) V8only. - -Record Ring_Theory : Prop := -{ Th_plus_sym : (n,m:A) n + m == m + n; - Th_plus_assoc : (n,m,p:A) n + (m + p) == (n + m) + p; - Th_mult_sym : (n,m:A) n*m == m*n; - Th_mult_assoc : (n,m,p:A) n*(m*p) == (n*m)*p; - Th_plus_zero_left :(n:A) 0 + n == n; - Th_mult_one_left : (n:A) 1*n == n; - Th_opp_def : (n:A) n + (-n) == 0; - Th_distr_left : (n,m,p:A) (n + m)*p == n*p + m*p; - Th_eq_prop : (x,y:A) (Is_true (Aeq x y)) -> x==y -}. +Notation "- x" := (Aopp x). + +Record Ring_Theory : Prop := + {Th_plus_comm : forall n m:A, n + m = m + n; + Th_plus_assoc : forall n m p:A, n + (m + p) = n + m + p; + Th_mult_sym : forall n m:A, n * m = m * n; + Th_mult_assoc : forall n m p:A, n * (m * p) = n * m * p; + Th_plus_zero_left : forall n:A, 0 + n = n; + Th_mult_one_left : forall n:A, 1 * n = n; + Th_opp_def : forall n:A, n + - n = 0; + Th_distr_left : forall n m p:A, (n + m) * p = n * p + m * p; + Th_eq_prop : forall x y:A, Is_true (Aeq x y) -> x = y}. Variable T : Ring_Theory. -Local plus_sym := (Th_plus_sym T). -Local plus_assoc := (Th_plus_assoc T). -Local mult_sym := ( Th_mult_sym T). -Local mult_assoc := (Th_mult_assoc T). -Local plus_zero_left := (Th_plus_zero_left T). -Local mult_one_left := (Th_mult_one_left T). -Local opp_def := (Th_opp_def T). -Local distr_left := (Th_distr_left T). +Let plus_comm := Th_plus_comm T. +Let plus_assoc := Th_plus_assoc T. +Let mult_comm := Th_mult_sym T. +Let mult_assoc := Th_mult_assoc T. +Let plus_zero_left := Th_plus_zero_left T. +Let mult_one_left := Th_mult_one_left T. +Let opp_def := Th_opp_def T. +Let distr_left := Th_distr_left T. -Hints Resolve plus_sym plus_assoc mult_sym mult_assoc - plus_zero_left mult_one_left opp_def distr_left. +Hint Resolve plus_comm plus_assoc mult_comm mult_assoc plus_zero_left + mult_one_left opp_def distr_left. (* Lemmas whose form is x=y are also provided in form y=x because Auto does not symmetry *) -Lemma Th_mult_assoc2 : (n,m,p:A) (n * m) * p == n * (m * p). -Symmetry; EAuto. Qed. +Lemma Th_mult_assoc2 : forall n m p:A, n * m * p = n * (m * p). +symmetry in |- *; eauto. Qed. -Lemma Th_plus_assoc2 : (n,m,p:A) (n + m) + p == n + (m + p). -Symmetry; EAuto. Qed. +Lemma Th_plus_assoc2 : forall n m p:A, n + m + p = n + (m + p). +symmetry in |- *; eauto. Qed. -Lemma Th_plus_zero_left2 : (n:A) n == 0 + n. -Symmetry; EAuto. Qed. +Lemma Th_plus_zero_left2 : forall n:A, n = 0 + n. +symmetry in |- *; eauto. Qed. -Lemma Th_mult_one_left2 : (n:A) n == 1*n. -Symmetry; EAuto. Qed. +Lemma Th_mult_one_left2 : forall n:A, n = 1 * n. +symmetry in |- *; eauto. Qed. -Lemma Th_distr_left2 : (n,m,p:A) n*p + m*p == (n + m)*p. -Symmetry; EAuto. Qed. +Lemma Th_distr_left2 : forall n m p:A, n * p + m * p = (n + m) * p. +symmetry in |- *; eauto. Qed. -Lemma Th_opp_def2 : (n:A) 0 == n + (-n). -Symmetry; EAuto. Qed. +Lemma Th_opp_def2 : forall n:A, 0 = n + - n. +symmetry in |- *; eauto. Qed. -Lemma Th_plus_permute : (n,m,p:A) n + (m + p) == m + (n + p). -Intros. -Rewrite -> plus_assoc. -Elim (plus_sym m n). -Rewrite <- plus_assoc. -Reflexivity. +Lemma Th_plus_permute : forall n m p:A, n + (m + p) = m + (n + p). +intros. +rewrite plus_assoc. +elim (plus_comm m n). +rewrite <- plus_assoc. +reflexivity. Qed. -Lemma Th_mult_permute : (n,m,p:A) n*(m*p) == m*(n*p). -Intros. -Rewrite -> mult_assoc. -Elim (mult_sym m n). -Rewrite <- mult_assoc. -Reflexivity. +Lemma Th_mult_permute : forall n m p:A, n * (m * p) = m * (n * p). +intros. +rewrite mult_assoc. +elim (mult_comm m n). +rewrite <- mult_assoc. +reflexivity. Qed. -Hints Resolve Th_plus_permute Th_mult_permute. - -Lemma aux1 : (a:A) a + a == a -> a == 0. -Intros. -Generalize (opp_def a). -Pattern 1 a. -Rewrite <- H. -Rewrite <- plus_assoc. -Rewrite -> opp_def. -Elim plus_sym. -Rewrite plus_zero_left. -Trivial. +Hint Resolve Th_plus_permute Th_mult_permute. + +Lemma aux1 : forall a:A, a + a = a -> a = 0. +intros. +generalize (opp_def a). +pattern a at 1 in |- *. +rewrite <- H. +rewrite <- plus_assoc. +rewrite opp_def. +elim plus_comm. +rewrite plus_zero_left. +trivial. Qed. -Lemma Th_mult_zero_left :(n:A) 0*n == 0. -Intros. -Apply aux1. -Rewrite <- distr_left. -Rewrite plus_zero_left. -Reflexivity. +Lemma Th_mult_zero_left : forall n:A, 0 * n = 0. +intros. +apply aux1. +rewrite <- distr_left. +rewrite plus_zero_left. +reflexivity. Qed. -Hints Resolve Th_mult_zero_left. - -Lemma Th_mult_zero_left2 : (n:A) 0 == 0*n. -Symmetry; EAuto. Qed. - -Lemma aux2 : (x,y,z:A) x+y==0 -> x+z==0 -> y==z. -Intros. -Rewrite <- (plus_zero_left y). -Elim H0. -Elim plus_assoc. -Elim (plus_sym y z). -Rewrite -> plus_assoc. -Rewrite -> H. -Rewrite plus_zero_left. -Reflexivity. +Hint Resolve Th_mult_zero_left. + +Lemma Th_mult_zero_left2 : forall n:A, 0 = 0 * n. +symmetry in |- *; eauto. Qed. + +Lemma aux2 : forall x y z:A, x + y = 0 -> x + z = 0 -> y = z. +intros. +rewrite <- (plus_zero_left y). +elim H0. +elim plus_assoc. +elim (plus_comm y z). +rewrite plus_assoc. +rewrite H. +rewrite plus_zero_left. +reflexivity. Qed. -Lemma Th_opp_mult_left : (x,y:A) -(x*y) == (-x)*y. -Intros. -Apply (aux2 1!x*y); -[ Apply opp_def -| Rewrite <- distr_left; - Rewrite -> opp_def; - Auto]. +Lemma Th_opp_mult_left : forall x y:A, - (x * y) = - x * y. +intros. +apply (aux2 (x:=(x * y))); + [ apply opp_def | rewrite <- distr_left; rewrite opp_def; auto ]. Qed. -Hints Resolve Th_opp_mult_left. +Hint Resolve Th_opp_mult_left. -Lemma Th_opp_mult_left2 : (x,y:A) (-x)*y == -(x*y). -Symmetry; EAuto. Qed. +Lemma Th_opp_mult_left2 : forall x y:A, - x * y = - (x * y). +symmetry in |- *; eauto. Qed. -Lemma Th_mult_zero_right : (n:A) n*0 == 0. -Intro; Elim mult_sym; EAuto. +Lemma Th_mult_zero_right : forall n:A, n * 0 = 0. +intro; elim mult_comm; eauto. Qed. -Lemma Th_mult_zero_right2 : (n:A) 0 == n*0. -Intro; Elim mult_sym; EAuto. +Lemma Th_mult_zero_right2 : forall n:A, 0 = n * 0. +intro; elim mult_comm; eauto. Qed. -Lemma Th_plus_zero_right :(n:A) n + 0 == n. -Intro; Rewrite plus_sym; EAuto. +Lemma Th_plus_zero_right : forall n:A, n + 0 = n. +intro; rewrite plus_comm; eauto. Qed. -Lemma Th_plus_zero_right2 :(n:A) n == n + 0. -Intro; Rewrite plus_sym; EAuto. +Lemma Th_plus_zero_right2 : forall n:A, n = n + 0. +intro; rewrite plus_comm; eauto. Qed. -Lemma Th_mult_one_right : (n:A) n*1 == n. -Intro;Elim mult_sym; EAuto. +Lemma Th_mult_one_right : forall n:A, n * 1 = n. +intro; elim mult_comm; eauto. Qed. -Lemma Th_mult_one_right2 : (n:A) n == n*1. -Intro;Elim mult_sym; EAuto. +Lemma Th_mult_one_right2 : forall n:A, n = n * 1. +intro; elim mult_comm; eauto. Qed. -Lemma Th_opp_mult_right : (x,y:A) -(x*y) == x*(-y). -Intros; Do 2 Rewrite -> (mult_sym x); Auto. +Lemma Th_opp_mult_right : forall x y:A, - (x * y) = x * - y. +intros; do 2 rewrite (mult_comm x); auto. Qed. -Lemma Th_opp_mult_right2 : (x,y:A) x*(-y) == -(x*y). -Intros; Do 2 Rewrite -> (mult_sym x); Auto. +Lemma Th_opp_mult_right2 : forall x y:A, x * - y = - (x * y). +intros; do 2 rewrite (mult_comm x); auto. Qed. -Lemma Th_plus_opp_opp : (x,y:A) (-x) + (-y) == -(x+y). -Intros. -Apply (aux2 1! x + y); -[ Elim plus_assoc; - Rewrite -> (Th_plus_permute y (-x)); Rewrite -> plus_assoc; - Rewrite -> opp_def; Rewrite plus_zero_left; Auto -| Auto ]. +Lemma Th_plus_opp_opp : forall x y:A, - x + - y = - (x + y). +intros. +apply (aux2 (x:=(x + y))); + [ elim plus_assoc; rewrite (Th_plus_permute y (- x)); rewrite plus_assoc; + rewrite opp_def; rewrite plus_zero_left; auto + | auto ]. Qed. -Lemma Th_plus_permute_opp: (n,m,p:A) (-m)+(n+p) == n+((-m)+p). -EAuto. Qed. +Lemma Th_plus_permute_opp : forall n m p:A, - m + (n + p) = n + (- m + p). +eauto. Qed. -Lemma Th_opp_opp : (n:A) -(-n) == n. -Intro; Apply (aux2 1! -n); - [ Auto | Elim plus_sym; Auto ]. +Lemma Th_opp_opp : forall n:A, - - n = n. +intro; apply (aux2 (x:=(- n))); [ auto | elim plus_comm; auto ]. Qed. -Hints Resolve Th_opp_opp. +Hint Resolve Th_opp_opp. -Lemma Th_opp_opp2 : (n:A) n == -(-n). -Symmetry; EAuto. Qed. +Lemma Th_opp_opp2 : forall n:A, n = - - n. +symmetry in |- *; eauto. Qed. -Lemma Th_mult_opp_opp : (x,y:A) (-x)*(-y) == x*y. -Intros; Rewrite <- Th_opp_mult_left; Rewrite <- Th_opp_mult_right; Auto. +Lemma Th_mult_opp_opp : forall x y:A, - x * - y = x * y. +intros; rewrite <- Th_opp_mult_left; rewrite <- Th_opp_mult_right; auto. Qed. -Lemma Th_mult_opp_opp2 : (x,y:A) x*y == (-x)*(-y). -Symmetry; Apply Th_mult_opp_opp. Qed. +Lemma Th_mult_opp_opp2 : forall x y:A, x * y = - x * - y. +symmetry in |- *; apply Th_mult_opp_opp. Qed. -Lemma Th_opp_zero : -0 == 0. -Rewrite <- (plus_zero_left (-0)). -Auto. Qed. +Lemma Th_opp_zero : - 0 = 0. +rewrite <- (plus_zero_left (- 0)). +auto. Qed. -Lemma Th_plus_reg_left : (n,m,p:A) n + m == n + p -> m==p. -Intros; Generalize (congr_eqT ? ? [z] (-n)+z ? ? H). -Repeat Rewrite plus_assoc. -Rewrite (plus_sym (-n) n). -Rewrite opp_def. -Repeat Rewrite Th_plus_zero_left; EAuto. +Lemma Th_plus_reg_left : forall n m p:A, n + m = n + p -> m = p. +intros; generalize (f_equal (fun z => - n + z) H). +repeat rewrite plus_assoc. +rewrite (plus_comm (- n) n). +rewrite opp_def. +repeat rewrite Th_plus_zero_left; eauto. Qed. -Lemma Th_plus_reg_right : (n,m,p:A) m + n == p + n -> m==p. -Intros. -EApply Th_plus_reg_left with n. -Rewrite (plus_sym n m). -Rewrite (plus_sym n p). -Auto. +Lemma Th_plus_reg_right : forall n m p:A, m + n = p + n -> m = p. +intros. +eapply Th_plus_reg_left with n. +rewrite (plus_comm n m). +rewrite (plus_comm n p). +auto. Qed. -Lemma Th_distr_right : (n,m,p:A) n*(m + p) == (n*m) + (n*p). -Intros. -Repeat Rewrite -> (mult_sym n). -EAuto. +Lemma Th_distr_right : forall n m p:A, n * (m + p) = n * m + n * p. +intros. +repeat rewrite (mult_comm n). +eauto. Qed. -Lemma Th_distr_right2 : (n,m,p:A) (n*m) + (n*p) == n*(m + p). -Symmetry; Apply Th_distr_right. +Lemma Th_distr_right2 : forall n m p:A, n * m + n * p = n * (m + p). +symmetry in |- *; apply Th_distr_right. Qed. End Theory_of_rings. -Hints Resolve Th_mult_zero_left Th_plus_reg_left : core. +Hint Resolve Th_mult_zero_left Th_plus_reg_left: core. Unset Implicit Arguments. Definition Semi_Ring_Theory_of : - (A:Type)(Aplus : A -> A -> A)(Amult : A -> A -> A)(Aone : A) - (Azero : A)(Aopp : A -> A)(Aeq : A -> A -> bool) - (Ring_Theory Aplus Amult Aone Azero Aopp Aeq) - ->(Semi_Ring_Theory Aplus Amult Aone Azero Aeq). -Intros until 1; Case H. -Split; Intros; Simpl; EAuto. + forall (A:Type) (Aplus Amult:A -> A -> A) (Aone Azero:A) + (Aopp:A -> A) (Aeq:A -> A -> bool), + Ring_Theory Aplus Amult Aone Azero Aopp Aeq -> + Semi_Ring_Theory Aplus Amult Aone Azero Aeq. +intros until 1; case H. +split; intros; simpl in |- *; eauto. Defined. (* Every ring can be viewed as a semi-ring : this property will be used @@ -381,4 +373,4 @@ End product_ring. Section power_ring. -End power_ring. +End power_ring.
\ No newline at end of file diff --git a/contrib/ring/Setoid_ring.v b/contrib/ring/Setoid_ring.v index 567517e98..6c33032a2 100644 --- a/contrib/ring/Setoid_ring.v +++ b/contrib/ring/Setoid_ring.v @@ -10,4 +10,4 @@ Require Export Setoid_ring_theory. Require Export Quote. -Require Export Setoid_ring_normalize. +Require Export Setoid_ring_normalize.
\ No newline at end of file diff --git a/contrib/ring/Setoid_ring_normalize.v b/contrib/ring/Setoid_ring_normalize.v index bbebde422..c619f3265 100644 --- a/contrib/ring/Setoid_ring_normalize.v +++ b/contrib/ring/Setoid_ring_normalize.v @@ -8,17 +8,18 @@ (* $Id$ *) -Require Setoid_ring_theory. -Require Quote. +Require Import Setoid_ring_theory. +Require Import Quote. Set Implicit Arguments. -Lemma index_eq_prop: (n,m:index)(Is_true (index_eq n m)) -> n=m. +Lemma index_eq_prop : forall n m:index, Is_true (index_eq n m) -> n = m. Proof. - Induction n; Induction m; Simpl; Try (Reflexivity Orelse Contradiction). - Intros; Rewrite (H i0); Trivial. - Intros; Rewrite (H i0); Trivial. -Save. + simple induction n; simple induction m; simpl in |- *; + try reflexivity || contradiction. + intros; rewrite (H i0); trivial. + intros; rewrite (H i0); trivial. +Qed. Section setoid. @@ -31,35 +32,38 @@ Variable Azero : A. Variable Aopp : A -> A. Variable Aeq : A -> A -> bool. -Variable S : (Setoid_Theory A Aequiv). +Variable S : Setoid_Theory A Aequiv. Add Setoid A Aequiv S. -Variable plus_morph : (a,a0,a1,a2:A) - (Aequiv a a0)->(Aequiv a1 a2)->(Aequiv (Aplus a a1) (Aplus a0 a2)). -Variable mult_morph : (a,a0,a1,a2:A) - (Aequiv a a0)->(Aequiv a1 a2)->(Aequiv (Amult a a1) (Amult a0 a2)). -Variable opp_morph : (a,a0:A) - (Aequiv a a0)->(Aequiv (Aopp a) (Aopp a0)). +Variable + plus_morph : + forall a a0 a1 a2:A, + Aequiv a a0 -> Aequiv a1 a2 -> Aequiv (Aplus a a1) (Aplus a0 a2). +Variable + mult_morph : + forall a a0 a1 a2:A, + Aequiv a a0 -> Aequiv a1 a2 -> Aequiv (Amult a a1) (Amult a0 a2). +Variable opp_morph : forall a a0:A, Aequiv a a0 -> Aequiv (Aopp a) (Aopp a0). Add Morphism Aplus : Aplus_ext. -Exact plus_morph. -Save. +exact plus_morph. +Qed. Add Morphism Amult : Amult_ext. -Exact mult_morph. -Save. +exact mult_morph. +Qed. Add Morphism Aopp : Aopp_ext. -Exact opp_morph. -Save. +exact opp_morph. +Qed. -Local equiv_refl := (Seq_refl A Aequiv S). -Local equiv_sym := (Seq_sym A Aequiv S). -Local equiv_trans := (Seq_trans A Aequiv S). +Let equiv_refl := Seq_refl A Aequiv S. +Let equiv_sym := Seq_sym A Aequiv S. +Let equiv_trans := Seq_trans A Aequiv S. -Hints Resolve equiv_refl equiv_trans. -Hints Immediate equiv_sym. +Hint Resolve equiv_refl equiv_trans. +Hint Immediate equiv_sym. Section semi_setoid_rings. @@ -81,16 +85,14 @@ Section semi_setoid_rings. (* varlist is isomorphic to (list var), but we built a special inductive for efficiency *) -Inductive varlist : Type := -| Nil_var : varlist -| Cons_var : index -> varlist -> varlist -. +Inductive varlist : Type := + | Nil_var : varlist + | Cons_var : index -> varlist -> varlist. -Inductive canonical_sum : Type := -| Nil_monom : canonical_sum -| Cons_monom : A -> varlist -> canonical_sum -> canonical_sum -| Cons_varlist : varlist -> canonical_sum -> canonical_sum -. +Inductive canonical_sum : Type := + | Nil_monom : canonical_sum + | Cons_monom : A -> varlist -> canonical_sum -> canonical_sum + | Cons_varlist : varlist -> canonical_sum -> canonical_sum. (* Order on monoms *) @@ -107,244 +109,251 @@ Inductive canonical_sum : Type := 4*x*y < 59*x*y*y*z *) -Fixpoint varlist_eq [x,y:varlist] : bool := - Cases x y of - | Nil_var Nil_var => true - | (Cons_var i xrest) (Cons_var j yrest) => - (andb (index_eq i j) (varlist_eq xrest yrest)) - | _ _ => false +Fixpoint varlist_eq (x y:varlist) {struct y} : bool := + match x, y with + | Nil_var, Nil_var => true + | Cons_var i xrest, Cons_var j yrest => + andb (index_eq i j) (varlist_eq xrest yrest) + | _, _ => false end. -Fixpoint varlist_lt [x,y:varlist] : bool := - Cases x y of - | Nil_var (Cons_var _ _) => true - | (Cons_var i xrest) (Cons_var j yrest) => - if (index_lt i j) then true - else (andb (index_eq i j) (varlist_lt xrest yrest)) - | _ _ => false +Fixpoint varlist_lt (x y:varlist) {struct y} : bool := + match x, y with + | Nil_var, Cons_var _ _ => true + | Cons_var i xrest, Cons_var j yrest => + if index_lt i j + then true + else andb (index_eq i j) (varlist_lt xrest yrest) + | _, _ => false end. (* merges two variables lists *) -Fixpoint varlist_merge [l1:varlist] : varlist -> varlist := - Cases l1 of - | (Cons_var v1 t1) => - Fix vm_aux {vm_aux [l2:varlist] : varlist := - Cases l2 of - | (Cons_var v2 t2) => - if (index_lt v1 v2) - then (Cons_var v1 (varlist_merge t1 l2)) - else (Cons_var v2 (vm_aux t2)) - | Nil_var => l1 - end} - | Nil_var => [l2]l2 +Fixpoint varlist_merge (l1:varlist) : varlist -> varlist := + match l1 with + | Cons_var v1 t1 => + (fix vm_aux (l2:varlist) : varlist := + match l2 with + | Cons_var v2 t2 => + if index_lt v1 v2 + then Cons_var v1 (varlist_merge t1 l2) + else Cons_var v2 (vm_aux t2) + | Nil_var => l1 + end) + | Nil_var => fun l2 => l2 end. (* returns the sum of two canonical sums *) -Fixpoint canonical_sum_merge [s1:canonical_sum] - : canonical_sum -> canonical_sum := -Cases s1 of -| (Cons_monom c1 l1 t1) => - Fix csm_aux{csm_aux[s2:canonical_sum] : canonical_sum := - Cases s2 of - | (Cons_monom c2 l2 t2) => - if (varlist_eq l1 l2) - then (Cons_monom (Aplus c1 c2) l1 - (canonical_sum_merge t1 t2)) - else if (varlist_lt l1 l2) - then (Cons_monom c1 l1 (canonical_sum_merge t1 s2)) - else (Cons_monom c2 l2 (csm_aux t2)) - | (Cons_varlist l2 t2) => - if (varlist_eq l1 l2) - then (Cons_monom (Aplus c1 Aone) l1 - (canonical_sum_merge t1 t2)) - else if (varlist_lt l1 l2) - then (Cons_monom c1 l1 (canonical_sum_merge t1 s2)) - else (Cons_varlist l2 (csm_aux t2)) - | Nil_monom => s1 - end} -| (Cons_varlist l1 t1) => - Fix csm_aux2{csm_aux2[s2:canonical_sum] : canonical_sum := - Cases s2 of - | (Cons_monom c2 l2 t2) => - if (varlist_eq l1 l2) - then (Cons_monom (Aplus Aone c2) l1 - (canonical_sum_merge t1 t2)) - else if (varlist_lt l1 l2) - then (Cons_varlist l1 (canonical_sum_merge t1 s2)) - else (Cons_monom c2 l2 (csm_aux2 t2)) - | (Cons_varlist l2 t2) => - if (varlist_eq l1 l2) - then (Cons_monom (Aplus Aone Aone) l1 - (canonical_sum_merge t1 t2)) - else if (varlist_lt l1 l2) - then (Cons_varlist l1 (canonical_sum_merge t1 s2)) - else (Cons_varlist l2 (csm_aux2 t2)) - | Nil_monom => s1 - end} -| Nil_monom => [s2]s2 -end. +Fixpoint canonical_sum_merge (s1:canonical_sum) : + canonical_sum -> canonical_sum := + match s1 with + | Cons_monom c1 l1 t1 => + (fix csm_aux (s2:canonical_sum) : canonical_sum := + match s2 with + | Cons_monom c2 l2 t2 => + if varlist_eq l1 l2 + then Cons_monom (Aplus c1 c2) l1 (canonical_sum_merge t1 t2) + else + if varlist_lt l1 l2 + then Cons_monom c1 l1 (canonical_sum_merge t1 s2) + else Cons_monom c2 l2 (csm_aux t2) + | Cons_varlist l2 t2 => + if varlist_eq l1 l2 + then Cons_monom (Aplus c1 Aone) l1 (canonical_sum_merge t1 t2) + else + if varlist_lt l1 l2 + then Cons_monom c1 l1 (canonical_sum_merge t1 s2) + else Cons_varlist l2 (csm_aux t2) + | Nil_monom => s1 + end) + | Cons_varlist l1 t1 => + (fix csm_aux2 (s2:canonical_sum) : canonical_sum := + match s2 with + | Cons_monom c2 l2 t2 => + if varlist_eq l1 l2 + then Cons_monom (Aplus Aone c2) l1 (canonical_sum_merge t1 t2) + else + if varlist_lt l1 l2 + then Cons_varlist l1 (canonical_sum_merge t1 s2) + else Cons_monom c2 l2 (csm_aux2 t2) + | Cons_varlist l2 t2 => + if varlist_eq l1 l2 + then Cons_monom (Aplus Aone Aone) l1 (canonical_sum_merge t1 t2) + else + if varlist_lt l1 l2 + then Cons_varlist l1 (canonical_sum_merge t1 s2) + else Cons_varlist l2 (csm_aux2 t2) + | Nil_monom => s1 + end) + | Nil_monom => fun s2 => s2 + end. (* Insertion of a monom in a canonical sum *) -Fixpoint monom_insert [c1:A; l1:varlist; s2 : canonical_sum] - : canonical_sum := - Cases s2 of - | (Cons_monom c2 l2 t2) => - if (varlist_eq l1 l2) - then (Cons_monom (Aplus c1 c2) l1 t2) - else if (varlist_lt l1 l2) - then (Cons_monom c1 l1 s2) - else (Cons_monom c2 l2 (monom_insert c1 l1 t2)) - | (Cons_varlist l2 t2) => - if (varlist_eq l1 l2) - then (Cons_monom (Aplus c1 Aone) l1 t2) - else if (varlist_lt l1 l2) - then (Cons_monom c1 l1 s2) - else (Cons_varlist l2 (monom_insert c1 l1 t2)) - | Nil_monom => (Cons_monom c1 l1 Nil_monom) +Fixpoint monom_insert (c1:A) (l1:varlist) (s2:canonical_sum) {struct s2} : + canonical_sum := + match s2 with + | Cons_monom c2 l2 t2 => + if varlist_eq l1 l2 + then Cons_monom (Aplus c1 c2) l1 t2 + else + if varlist_lt l1 l2 + then Cons_monom c1 l1 s2 + else Cons_monom c2 l2 (monom_insert c1 l1 t2) + | Cons_varlist l2 t2 => + if varlist_eq l1 l2 + then Cons_monom (Aplus c1 Aone) l1 t2 + else + if varlist_lt l1 l2 + then Cons_monom c1 l1 s2 + else Cons_varlist l2 (monom_insert c1 l1 t2) + | Nil_monom => Cons_monom c1 l1 Nil_monom end. -Fixpoint varlist_insert [l1:varlist; s2:canonical_sum] - : canonical_sum := - Cases s2 of - | (Cons_monom c2 l2 t2) => - if (varlist_eq l1 l2) - then (Cons_monom (Aplus Aone c2) l1 t2) - else if (varlist_lt l1 l2) - then (Cons_varlist l1 s2) - else (Cons_monom c2 l2 (varlist_insert l1 t2)) - | (Cons_varlist l2 t2) => - if (varlist_eq l1 l2) - then (Cons_monom (Aplus Aone Aone) l1 t2) - else if (varlist_lt l1 l2) - then (Cons_varlist l1 s2) - else (Cons_varlist l2 (varlist_insert l1 t2)) - | Nil_monom => (Cons_varlist l1 Nil_monom) +Fixpoint varlist_insert (l1:varlist) (s2:canonical_sum) {struct s2} : + canonical_sum := + match s2 with + | Cons_monom c2 l2 t2 => + if varlist_eq l1 l2 + then Cons_monom (Aplus Aone c2) l1 t2 + else + if varlist_lt l1 l2 + then Cons_varlist l1 s2 + else Cons_monom c2 l2 (varlist_insert l1 t2) + | Cons_varlist l2 t2 => + if varlist_eq l1 l2 + then Cons_monom (Aplus Aone Aone) l1 t2 + else + if varlist_lt l1 l2 + then Cons_varlist l1 s2 + else Cons_varlist l2 (varlist_insert l1 t2) + | Nil_monom => Cons_varlist l1 Nil_monom end. (* Computes c0*s *) -Fixpoint canonical_sum_scalar [c0:A; s:canonical_sum] : canonical_sum := - Cases s of - | (Cons_monom c l t) => - (Cons_monom (Amult c0 c) l (canonical_sum_scalar c0 t)) - | (Cons_varlist l t) => - (Cons_monom c0 l (canonical_sum_scalar c0 t)) - | Nil_monom => Nil_monom - end. +Fixpoint canonical_sum_scalar (c0:A) (s:canonical_sum) {struct s} : + canonical_sum := + match s with + | Cons_monom c l t => Cons_monom (Amult c0 c) l (canonical_sum_scalar c0 t) + | Cons_varlist l t => Cons_monom c0 l (canonical_sum_scalar c0 t) + | Nil_monom => Nil_monom + end. (* Computes l0*s *) -Fixpoint canonical_sum_scalar2 [l0:varlist; s:canonical_sum] - : canonical_sum := - Cases s of - | (Cons_monom c l t) => - (monom_insert c (varlist_merge l0 l) (canonical_sum_scalar2 l0 t)) - | (Cons_varlist l t) => - (varlist_insert (varlist_merge l0 l) (canonical_sum_scalar2 l0 t)) - | Nil_monom => Nil_monom - end. +Fixpoint canonical_sum_scalar2 (l0:varlist) (s:canonical_sum) {struct s} : + canonical_sum := + match s with + | Cons_monom c l t => + monom_insert c (varlist_merge l0 l) (canonical_sum_scalar2 l0 t) + | Cons_varlist l t => + varlist_insert (varlist_merge l0 l) (canonical_sum_scalar2 l0 t) + | Nil_monom => Nil_monom + end. (* Computes c0*l0*s *) -Fixpoint canonical_sum_scalar3 [c0:A;l0:varlist; s:canonical_sum] - : canonical_sum := - Cases s of - | (Cons_monom c l t) => - (monom_insert (Amult c0 c) (varlist_merge l0 l) - (canonical_sum_scalar3 c0 l0 t)) - | (Cons_varlist l t) => - (monom_insert c0 (varlist_merge l0 l) - (canonical_sum_scalar3 c0 l0 t)) - | Nil_monom => Nil_monom - end. +Fixpoint canonical_sum_scalar3 (c0:A) (l0:varlist) + (s:canonical_sum) {struct s} : canonical_sum := + match s with + | Cons_monom c l t => + monom_insert (Amult c0 c) (varlist_merge l0 l) + (canonical_sum_scalar3 c0 l0 t) + | Cons_varlist l t => + monom_insert c0 (varlist_merge l0 l) (canonical_sum_scalar3 c0 l0 t) + | Nil_monom => Nil_monom + end. (* returns the product of two canonical sums *) -Fixpoint canonical_sum_prod [s1:canonical_sum] - : canonical_sum -> canonical_sum := - [s2]Cases s1 of - | (Cons_monom c1 l1 t1) => - (canonical_sum_merge (canonical_sum_scalar3 c1 l1 s2) - (canonical_sum_prod t1 s2)) - | (Cons_varlist l1 t1) => - (canonical_sum_merge (canonical_sum_scalar2 l1 s2) - (canonical_sum_prod t1 s2)) - | Nil_monom => Nil_monom - end. +Fixpoint canonical_sum_prod (s1 s2:canonical_sum) {struct s1} : + canonical_sum := + match s1 with + | Cons_monom c1 l1 t1 => + canonical_sum_merge (canonical_sum_scalar3 c1 l1 s2) + (canonical_sum_prod t1 s2) + | Cons_varlist l1 t1 => + canonical_sum_merge (canonical_sum_scalar2 l1 s2) + (canonical_sum_prod t1 s2) + | Nil_monom => Nil_monom + end. (* The type to represent concrete semi-setoid-ring polynomials *) -Inductive Type setspolynomial := - SetSPvar : index -> setspolynomial -| SetSPconst : A -> setspolynomial -| SetSPplus : setspolynomial -> setspolynomial -> setspolynomial -| SetSPmult : setspolynomial -> setspolynomial -> setspolynomial. - -Fixpoint setspolynomial_normalize [p:setspolynomial] : canonical_sum := - Cases p of - | (SetSPplus l r) => (canonical_sum_merge (setspolynomial_normalize l) (setspolynomial_normalize r)) - | (SetSPmult l r) => (canonical_sum_prod (setspolynomial_normalize l) (setspolynomial_normalize r)) - | (SetSPconst c) => (Cons_monom c Nil_var Nil_monom) - | (SetSPvar i) => (Cons_varlist (Cons_var i Nil_var) Nil_monom) - end. - -Fixpoint canonical_sum_simplify [ s:canonical_sum] : canonical_sum := - Cases s of - | (Cons_monom c l t) => - if (Aeq c Azero) - then (canonical_sum_simplify t) - else if (Aeq c Aone) - then (Cons_varlist l (canonical_sum_simplify t)) - else (Cons_monom c l (canonical_sum_simplify t)) - | (Cons_varlist l t) => (Cons_varlist l (canonical_sum_simplify t)) +Inductive setspolynomial : Type := + | SetSPvar : index -> setspolynomial + | SetSPconst : A -> setspolynomial + | SetSPplus : setspolynomial -> setspolynomial -> setspolynomial + | SetSPmult : setspolynomial -> setspolynomial -> setspolynomial. + +Fixpoint setspolynomial_normalize (p:setspolynomial) : canonical_sum := + match p with + | SetSPplus l r => + canonical_sum_merge (setspolynomial_normalize l) + (setspolynomial_normalize r) + | SetSPmult l r => + canonical_sum_prod (setspolynomial_normalize l) + (setspolynomial_normalize r) + | SetSPconst c => Cons_monom c Nil_var Nil_monom + | SetSPvar i => Cons_varlist (Cons_var i Nil_var) Nil_monom + end. + +Fixpoint canonical_sum_simplify (s:canonical_sum) : canonical_sum := + match s with + | Cons_monom c l t => + if Aeq c Azero + then canonical_sum_simplify t + else + if Aeq c Aone + then Cons_varlist l (canonical_sum_simplify t) + else Cons_monom c l (canonical_sum_simplify t) + | Cons_varlist l t => Cons_varlist l (canonical_sum_simplify t) | Nil_monom => Nil_monom end. -Definition setspolynomial_simplify := - [x:setspolynomial] (canonical_sum_simplify (setspolynomial_normalize x)). +Definition setspolynomial_simplify (x:setspolynomial) := + canonical_sum_simplify (setspolynomial_normalize x). -Variable vm : (varmap A). +Variable vm : varmap A. -Definition interp_var [i:index] := (varmap_find Azero i vm). +Definition interp_var (i:index) := varmap_find Azero i vm. -Definition ivl_aux := Fix ivl_aux {ivl_aux[x:index; t:varlist] : A := - Cases t of - | Nil_var => (interp_var x) - | (Cons_var x' t') => (Amult (interp_var x) (ivl_aux x' t')) - end}. +Definition ivl_aux := + (fix ivl_aux (x:index) (t:varlist) {struct t} : A := + match t with + | Nil_var => interp_var x + | Cons_var x' t' => Amult (interp_var x) (ivl_aux x' t') + end). -Definition interp_vl := [l:varlist] - Cases l of +Definition interp_vl (l:varlist) := + match l with | Nil_var => Aone - | (Cons_var x t) => (ivl_aux x t) + | Cons_var x t => ivl_aux x t end. -Definition interp_m := [c:A][l:varlist] - Cases l of +Definition interp_m (c:A) (l:varlist) := + match l with | Nil_var => c - | (Cons_var x t) => - (Amult c (ivl_aux x t)) + | Cons_var x t => Amult c (ivl_aux x t) end. -Definition ics_aux := Fix ics_aux{ics_aux[a:A; s:canonical_sum] : A := - Cases s of - | Nil_monom => a - | (Cons_varlist l t) => (Aplus a (ics_aux (interp_vl l) t)) - | (Cons_monom c l t) => (Aplus a (ics_aux (interp_m c l) t)) - end}. +Definition ics_aux := + (fix ics_aux (a:A) (s:canonical_sum) {struct s} : A := + match s with + | Nil_monom => a + | Cons_varlist l t => Aplus a (ics_aux (interp_vl l) t) + | Cons_monom c l t => Aplus a (ics_aux (interp_m c l) t) + end). -Definition interp_setcs : canonical_sum -> A := - [s]Cases s of +Definition interp_setcs (s:canonical_sum) : A := + match s with | Nil_monom => Azero - | (Cons_varlist l t) => - (ics_aux (interp_vl l) t) - | (Cons_monom c l t) => - (ics_aux (interp_m c l) t) + | Cons_varlist l t => ics_aux (interp_vl l) t + | Cons_monom c l t => ics_aux (interp_m c l) t end. -Fixpoint interp_setsp [p:setspolynomial] : A := - Cases p of - | (SetSPconst c) => c - | (SetSPvar i) => (interp_var i) - | (SetSPplus p1 p2) => (Aplus (interp_setsp p1) (interp_setsp p2)) - | (SetSPmult p1 p2) => (Amult (interp_setsp p1) (interp_setsp p2)) - end. +Fixpoint interp_setsp (p:setspolynomial) : A := + match p with + | SetSPconst c => c + | SetSPvar i => interp_var i + | SetSPplus p1 p2 => Aplus (interp_setsp p1) (interp_setsp p2) + | SetSPmult p1 p2 => Amult (interp_setsp p1) (interp_setsp p2) + end. (* End interpretation. *) @@ -352,655 +361,636 @@ Unset Implicit Arguments. (* Section properties. *) -Variable T : (Semi_Setoid_Ring_Theory Aequiv Aplus Amult Aone Azero Aeq). - -Hint SSR_plus_sym_T := Resolve (SSR_plus_sym T). -Hint SSR_plus_assoc_T := Resolve (SSR_plus_assoc T). -Hint SSR_plus_assoc2_T := Resolve (SSR_plus_assoc2 S T). -Hint SSR_mult_sym_T := Resolve (SSR_mult_sym T). -Hint SSR_mult_assoc_T := Resolve (SSR_mult_assoc T). -Hint SSR_mult_assoc2_T := Resolve (SSR_mult_assoc2 S T). -Hint SSR_plus_zero_left_T := Resolve (SSR_plus_zero_left T). -Hint SSR_plus_zero_left2_T := Resolve (SSR_plus_zero_left2 S T). -Hint SSR_mult_one_left_T := Resolve (SSR_mult_one_left T). -Hint SSR_mult_one_left2_T := Resolve (SSR_mult_one_left2 S T). -Hint SSR_mult_zero_left_T := Resolve (SSR_mult_zero_left T). -Hint SSR_mult_zero_left2_T := Resolve (SSR_mult_zero_left2 S T). -Hint SSR_distr_left_T := Resolve (SSR_distr_left T). -Hint SSR_distr_left2_T := Resolve (SSR_distr_left2 S T). -Hint SSR_plus_reg_left_T := Resolve (SSR_plus_reg_left T). -Hint SSR_plus_permute_T := Resolve (SSR_plus_permute S plus_morph T). -Hint SSR_mult_permute_T := Resolve (SSR_mult_permute S mult_morph T). -Hint SSR_distr_right_T := Resolve (SSR_distr_right S plus_morph T). -Hint SSR_distr_right2_T := Resolve (SSR_distr_right2 S plus_morph T). -Hint SSR_mult_zero_right_T := Resolve (SSR_mult_zero_right S T). -Hint SSR_mult_zero_right2_T := Resolve (SSR_mult_zero_right2 S T). -Hint SSR_plus_zero_right_T := Resolve (SSR_plus_zero_right S T). -Hint SSR_plus_zero_right2_T := Resolve (SSR_plus_zero_right2 S T). -Hint SSR_mult_one_right_T := Resolve (SSR_mult_one_right S T). -Hint SSR_mult_one_right2_T := Resolve (SSR_mult_one_right2 S T). -Hint SSR_plus_reg_right_T := Resolve (SSR_plus_reg_right S T). -Hints Resolve refl_equal sym_equal trans_equal. +Variable T : Semi_Setoid_Ring_Theory Aequiv Aplus Amult Aone Azero Aeq. + +Hint Resolve (SSR_plus_comm T). +Hint Resolve (SSR_plus_assoc T). +Hint Resolve (SSR_plus_assoc2 S T). +Hint Resolve (SSR_mult_comm T). +Hint Resolve (SSR_mult_assoc T). +Hint Resolve (SSR_mult_assoc2 S T). +Hint Resolve (SSR_plus_zero_left T). +Hint Resolve (SSR_plus_zero_left2 S T). +Hint Resolve (SSR_mult_one_left T). +Hint Resolve (SSR_mult_one_left2 S T). +Hint Resolve (SSR_mult_zero_left T). +Hint Resolve (SSR_mult_zero_left2 S T). +Hint Resolve (SSR_distr_left T). +Hint Resolve (SSR_distr_left2 S T). +Hint Resolve (SSR_plus_reg_left T). +Hint Resolve (SSR_plus_permute S plus_morph T). +Hint Resolve (SSR_mult_permute S mult_morph T). +Hint Resolve (SSR_distr_right S plus_morph T). +Hint Resolve (SSR_distr_right2 S plus_morph T). +Hint Resolve (SSR_mult_zero_right S T). +Hint Resolve (SSR_mult_zero_right2 S T). +Hint Resolve (SSR_plus_zero_right S T). +Hint Resolve (SSR_plus_zero_right2 S T). +Hint Resolve (SSR_mult_one_right S T). +Hint Resolve (SSR_mult_one_right2 S T). +Hint Resolve (SSR_plus_reg_right S T). +Hint Resolve refl_equal sym_equal trans_equal. (*Hints Resolve refl_eqT sym_eqT trans_eqT.*) -Hints Immediate T. +Hint Immediate T. -Lemma varlist_eq_prop : (x,y:varlist) - (Is_true (varlist_eq x y))->x==y. +Lemma varlist_eq_prop : forall x y:varlist, Is_true (varlist_eq x y) -> x = y. Proof. - Induction x; Induction y; Contradiction Orelse Try Reflexivity. - Simpl; Intros. - Generalize (andb_prop2 ? ? H1); Intros; Elim H2; Intros. - Rewrite (index_eq_prop H3); Rewrite (H v0 H4); Reflexivity. -Save. - -Remark ivl_aux_ok : (v:varlist)(i:index) - (Aequiv (ivl_aux i v) (Amult (interp_var i) (interp_vl v))). + simple induction x; simple induction y; contradiction || (try reflexivity). + simpl in |- *; intros. + generalize (andb_prop2 _ _ H1); intros; elim H2; intros. + rewrite (index_eq_prop _ _ H3); rewrite (H v0 H4); reflexivity. +Qed. + +Remark ivl_aux_ok : + forall (v:varlist) (i:index), + Aequiv (ivl_aux i v) (Amult (interp_var i) (interp_vl v)). Proof. - Induction v; Simpl; Intros. - Trivial. - Rewrite (H i); Trivial. -Save. - -Lemma varlist_merge_ok : (x,y:varlist) - (Aequiv (interp_vl (varlist_merge x y)) (Amult (interp_vl x) (interp_vl y))). + simple induction v; simpl in |- *; intros. + trivial. + rewrite (H i); trivial. +Qed. + +Lemma varlist_merge_ok : + forall x y:varlist, + Aequiv (interp_vl (varlist_merge x y)) (Amult (interp_vl x) (interp_vl y)). Proof. - Induction x. - Simpl; Trivial. - Induction y. - Simpl; Trivial. - Simpl; Intros. - Elim (index_lt i i0); Simpl; Intros. - - Rewrite (ivl_aux_ok v i). - Rewrite (ivl_aux_ok v0 i0). - Rewrite (ivl_aux_ok (varlist_merge v (Cons_var i0 v0)) i). - Rewrite (H (Cons_var i0 v0)). - Simpl. - Rewrite (ivl_aux_ok v0 i0). - EAuto. - - Rewrite (ivl_aux_ok v i). - Rewrite (ivl_aux_ok v0 i0). - Rewrite (ivl_aux_ok - (Fix vm_aux - {vm_aux [l2:varlist] : varlist := - Cases (l2) of - Nil_var => (Cons_var i v) - | (Cons_var v2 t2) => - (if (index_lt i v2) - then (Cons_var i (varlist_merge v l2)) - else (Cons_var v2 (vm_aux t2))) - end} v0) i0). - Rewrite H0. - Rewrite (ivl_aux_ok v i). - EAuto. -Save. - -Remark ics_aux_ok : (x:A)(s:canonical_sum) - (Aequiv (ics_aux x s) (Aplus x (interp_setcs s))). + simple induction x. + simpl in |- *; trivial. + simple induction y. + simpl in |- *; trivial. + simpl in |- *; intros. + elim (index_lt i i0); simpl in |- *; intros. + + rewrite (ivl_aux_ok v i). + rewrite (ivl_aux_ok v0 i0). + rewrite (ivl_aux_ok (varlist_merge v (Cons_var i0 v0)) i). + rewrite (H (Cons_var i0 v0)). + simpl in |- *. + rewrite (ivl_aux_ok v0 i0). + eauto. + + rewrite (ivl_aux_ok v i). + rewrite (ivl_aux_ok v0 i0). + rewrite + (ivl_aux_ok + ((fix vm_aux (l2:varlist) : varlist := + match l2 with + | Nil_var => Cons_var i v + | Cons_var v2 t2 => + if index_lt i v2 + then Cons_var i (varlist_merge v l2) + else Cons_var v2 (vm_aux t2) + end) v0) i0). + rewrite H0. + rewrite (ivl_aux_ok v i). + eauto. +Qed. + +Remark ics_aux_ok : + forall (x:A) (s:canonical_sum), + Aequiv (ics_aux x s) (Aplus x (interp_setcs s)). Proof. - Induction s; Simpl; Intros;Trivial. -Save. + simple induction s; simpl in |- *; intros; trivial. +Qed. -Remark interp_m_ok : (x:A)(l:varlist) - (Aequiv (interp_m x l) (Amult x (interp_vl l))). +Remark interp_m_ok : + forall (x:A) (l:varlist), Aequiv (interp_m x l) (Amult x (interp_vl l)). Proof. - NewDestruct l;Trivial. -Save. + destruct l as [| i v]; trivial. +Qed. -Hint ivl_aux_ok_ := Resolve ivl_aux_ok. -Hint ics_aux_ok_ := Resolve ics_aux_ok. -Hint interp_m_ok_ := Resolve interp_m_ok. +Hint Resolve ivl_aux_ok. +Hint Resolve ics_aux_ok. +Hint Resolve interp_m_ok. (* Hints Resolve ivl_aux_ok ics_aux_ok interp_m_ok. *) -Lemma canonical_sum_merge_ok : (x,y:canonical_sum) - (Aequiv (interp_setcs (canonical_sum_merge x y)) - (Aplus (interp_setcs x) (interp_setcs y))). +Lemma canonical_sum_merge_ok : + forall x y:canonical_sum, + Aequiv (interp_setcs (canonical_sum_merge x y)) + (Aplus (interp_setcs x) (interp_setcs y)). Proof. -Induction x; Simpl. -Trivial. - -Induction y; Simpl; Intros. -EAuto. - -Generalize (varlist_eq_prop v v0). -Elim (varlist_eq v v0). -Intros; Rewrite (H1 I). -Simpl. -Rewrite (ics_aux_ok (interp_m a v0) c). -Rewrite (ics_aux_ok (interp_m a0 v0) c0). -Rewrite (ics_aux_ok (interp_m (Aplus a a0) v0) - (canonical_sum_merge c c0)). -Rewrite (H c0). -Rewrite (interp_m_ok (Aplus a a0) v0). -Rewrite (interp_m_ok a v0). -Rewrite (interp_m_ok a0 v0). -Setoid_replace (Amult (Aplus a a0) (interp_vl v0)) - with (Aplus (Amult a (interp_vl v0)) (Amult a0 (interp_vl v0))). -Setoid_replace (Aplus - (Aplus (Amult a (interp_vl v0)) - (Amult a0 (interp_vl v0))) - (Aplus (interp_setcs c) (interp_setcs c0))) - with (Aplus (Amult a (interp_vl v0)) - (Aplus (Amult a0 (interp_vl v0)) - (Aplus (interp_setcs c) (interp_setcs c0)))). -Setoid_replace (Aplus (Aplus (Amult a (interp_vl v0)) (interp_setcs c)) - (Aplus (Amult a0 (interp_vl v0)) (interp_setcs c0))) - with (Aplus (Amult a (interp_vl v0)) - (Aplus (interp_setcs c) - (Aplus (Amult a0 (interp_vl v0)) (interp_setcs c0)))). -Auto. - -Elim (varlist_lt v v0); Simpl. -Intro. -Rewrite (ics_aux_ok (interp_m a v) - (canonical_sum_merge c (Cons_monom a0 v0 c0))). -Rewrite (ics_aux_ok (interp_m a v) c). -Rewrite (ics_aux_ok (interp_m a0 v0) c0). -Rewrite (H (Cons_monom a0 v0 c0)); Simpl. -Rewrite (ics_aux_ok (interp_m a0 v0) c0); Auto. - -Intro. -Rewrite (ics_aux_ok (interp_m a0 v0) - (Fix csm_aux - {csm_aux [s2:canonical_sum] : canonical_sum := - Cases (s2) of - Nil_monom => (Cons_monom a v c) - | (Cons_monom c2 l2 t2) => - (if (varlist_eq v l2) - then - (Cons_monom (Aplus a c2) v - (canonical_sum_merge c t2)) - else - (if (varlist_lt v l2) - then - (Cons_monom a v - (canonical_sum_merge c s2)) - else (Cons_monom c2 l2 (csm_aux t2)))) - | (Cons_varlist l2 t2) => - (if (varlist_eq v l2) - then - (Cons_monom (Aplus a Aone) v - (canonical_sum_merge c t2)) - else - (if (varlist_lt v l2) - then - (Cons_monom a v - (canonical_sum_merge c s2)) - else (Cons_varlist l2 (csm_aux t2)))) - end} c0)). -Rewrite H0. -Rewrite (ics_aux_ok (interp_m a v) c); -Rewrite (ics_aux_ok (interp_m a0 v0) c0); Simpl; Auto. - -Generalize (varlist_eq_prop v v0). -Elim (varlist_eq v v0). -Intros; Rewrite (H1 I). -Simpl. -Rewrite (ics_aux_ok (interp_m (Aplus a Aone) v0) - (canonical_sum_merge c c0)); -Rewrite (ics_aux_ok (interp_m a v0) c); -Rewrite (ics_aux_ok (interp_vl v0) c0). -Rewrite (H c0). -Rewrite (interp_m_ok (Aplus a Aone) v0). -Rewrite (interp_m_ok a v0). -Setoid_replace (Amult (Aplus a Aone) (interp_vl v0)) - with (Aplus (Amult a (interp_vl v0)) (Amult Aone (interp_vl v0))). -Setoid_replace (Aplus - (Aplus (Amult a (interp_vl v0)) - (Amult Aone (interp_vl v0))) - (Aplus (interp_setcs c) (interp_setcs c0))) - with (Aplus (Amult a (interp_vl v0)) - (Aplus (Amult Aone (interp_vl v0)) - (Aplus (interp_setcs c) (interp_setcs c0)))). -Setoid_replace (Aplus (Aplus (Amult a (interp_vl v0)) (interp_setcs c)) - (Aplus (interp_vl v0) (interp_setcs c0))) - with (Aplus (Amult a (interp_vl v0)) - (Aplus (interp_setcs c) (Aplus (interp_vl v0) (interp_setcs c0)))). -Setoid_replace (Amult Aone (interp_vl v0)) with (interp_vl v0). -Auto. - -Elim (varlist_lt v v0); Simpl. -Intro. -Rewrite (ics_aux_ok (interp_m a v) - (canonical_sum_merge c (Cons_varlist v0 c0))); -Rewrite (ics_aux_ok (interp_m a v) c); -Rewrite (ics_aux_ok (interp_vl v0) c0). -Rewrite (H (Cons_varlist v0 c0)); Simpl. -Rewrite (ics_aux_ok (interp_vl v0) c0). -Auto. - -Intro. -Rewrite (ics_aux_ok (interp_vl v0) - (Fix csm_aux - {csm_aux [s2:canonical_sum] : canonical_sum := - Cases (s2) of - Nil_monom => (Cons_monom a v c) - | (Cons_monom c2 l2 t2) => - (if (varlist_eq v l2) - then - (Cons_monom (Aplus a c2) v - (canonical_sum_merge c t2)) - else - (if (varlist_lt v l2) - then - (Cons_monom a v - (canonical_sum_merge c s2)) - else (Cons_monom c2 l2 (csm_aux t2)))) - | (Cons_varlist l2 t2) => - (if (varlist_eq v l2) - then - (Cons_monom (Aplus a Aone) v - (canonical_sum_merge c t2)) - else - (if (varlist_lt v l2) - then - (Cons_monom a v - (canonical_sum_merge c s2)) - else (Cons_varlist l2 (csm_aux t2)))) - end} c0)); Rewrite H0. -Rewrite (ics_aux_ok (interp_m a v) c); -Rewrite (ics_aux_ok (interp_vl v0) c0); Simpl. -Auto. - -Induction y; Simpl; Intros. -Trivial. - -Generalize (varlist_eq_prop v v0). -Elim (varlist_eq v v0). -Intros; Rewrite (H1 I). -Simpl. -Rewrite (ics_aux_ok (interp_m (Aplus Aone a) v0) - (canonical_sum_merge c c0)); -Rewrite (ics_aux_ok (interp_vl v0) c); -Rewrite (ics_aux_ok (interp_m a v0) c0); Rewrite ( -H c0). -Rewrite (interp_m_ok (Aplus Aone a) v0); -Rewrite (interp_m_ok a v0). -Setoid_replace (Amult (Aplus Aone a) (interp_vl v0)) - with (Aplus (Amult Aone (interp_vl v0)) (Amult a (interp_vl v0))); -Setoid_replace (Aplus - (Aplus (Amult Aone (interp_vl v0)) - (Amult a (interp_vl v0))) - (Aplus (interp_setcs c) (interp_setcs c0))) - with (Aplus (Amult Aone (interp_vl v0)) - (Aplus (Amult a (interp_vl v0)) - (Aplus (interp_setcs c) (interp_setcs c0)))); -Setoid_replace (Aplus (Aplus (interp_vl v0) (interp_setcs c)) - (Aplus (Amult a (interp_vl v0)) (interp_setcs c0))) - with (Aplus (interp_vl v0) - (Aplus (interp_setcs c) - (Aplus (Amult a (interp_vl v0)) (interp_setcs c0)))). -Auto. - -Elim (varlist_lt v v0); Simpl; Intros. -Rewrite (ics_aux_ok (interp_vl v) - (canonical_sum_merge c (Cons_monom a v0 c0))); -Rewrite (ics_aux_ok (interp_vl v) c); -Rewrite (ics_aux_ok (interp_m a v0) c0). -Rewrite (H (Cons_monom a v0 c0)); Simpl. -Rewrite (ics_aux_ok (interp_m a v0) c0); Auto. - -Rewrite (ics_aux_ok (interp_m a v0) - (Fix csm_aux2 - {csm_aux2 [s2:canonical_sum] : canonical_sum := - Cases (s2) of - Nil_monom => (Cons_varlist v c) - | (Cons_monom c2 l2 t2) => - (if (varlist_eq v l2) - then - (Cons_monom (Aplus Aone c2) v - (canonical_sum_merge c t2)) - else - (if (varlist_lt v l2) - then - (Cons_varlist v - (canonical_sum_merge c s2)) - else (Cons_monom c2 l2 (csm_aux2 t2)))) - | (Cons_varlist l2 t2) => - (if (varlist_eq v l2) - then - (Cons_monom (Aplus Aone Aone) v - (canonical_sum_merge c t2)) - else - (if (varlist_lt v l2) - then - (Cons_varlist v - (canonical_sum_merge c s2)) - else (Cons_varlist l2 (csm_aux2 t2)))) - end} c0)); Rewrite H0. -Rewrite (ics_aux_ok (interp_vl v) c); -Rewrite (ics_aux_ok (interp_m a v0) c0); Simpl; Auto. - -Generalize (varlist_eq_prop v v0). -Elim (varlist_eq v v0); Intros. -Rewrite (H1 I); Simpl. -Rewrite (ics_aux_ok (interp_m (Aplus Aone Aone) v0) - (canonical_sum_merge c c0)); -Rewrite (ics_aux_ok (interp_vl v0) c); -Rewrite (ics_aux_ok (interp_vl v0) c0); Rewrite ( -H c0). -Rewrite (interp_m_ok (Aplus Aone Aone) v0). -Setoid_replace (Amult (Aplus Aone Aone) (interp_vl v0)) - with (Aplus (Amult Aone (interp_vl v0)) (Amult Aone (interp_vl v0))); -Setoid_replace (Aplus - (Aplus (Amult Aone (interp_vl v0)) - (Amult Aone (interp_vl v0))) - (Aplus (interp_setcs c) (interp_setcs c0))) - with (Aplus (Amult Aone (interp_vl v0)) - (Aplus (Amult Aone (interp_vl v0)) - (Aplus (interp_setcs c) (interp_setcs c0)))); -Setoid_replace (Aplus (Aplus (interp_vl v0) (interp_setcs c)) - (Aplus (interp_vl v0) (interp_setcs c0))) - with (Aplus (interp_vl v0) - (Aplus (interp_setcs c) (Aplus (interp_vl v0) (interp_setcs c0)))). -Setoid_replace (Amult Aone (interp_vl v0)) with (interp_vl v0); Auto. - -Elim (varlist_lt v v0); Simpl. -Rewrite (ics_aux_ok (interp_vl v) - (canonical_sum_merge c (Cons_varlist v0 c0))); -Rewrite (ics_aux_ok (interp_vl v) c); -Rewrite (ics_aux_ok (interp_vl v0) c0); -Rewrite (H (Cons_varlist v0 c0)); Simpl. -Rewrite (ics_aux_ok (interp_vl v0) c0); Auto. - -Rewrite (ics_aux_ok (interp_vl v0) - (Fix csm_aux2 - {csm_aux2 [s2:canonical_sum] : canonical_sum := - Cases (s2) of - Nil_monom => (Cons_varlist v c) - | (Cons_monom c2 l2 t2) => - (if (varlist_eq v l2) - then - (Cons_monom (Aplus Aone c2) v - (canonical_sum_merge c t2)) - else - (if (varlist_lt v l2) - then - (Cons_varlist v - (canonical_sum_merge c s2)) - else (Cons_monom c2 l2 (csm_aux2 t2)))) - | (Cons_varlist l2 t2) => - (if (varlist_eq v l2) - then - (Cons_monom (Aplus Aone Aone) v - (canonical_sum_merge c t2)) - else - (if (varlist_lt v l2) - then - (Cons_varlist v - (canonical_sum_merge c s2)) - else (Cons_varlist l2 (csm_aux2 t2)))) - end} c0)); Rewrite H0. -Rewrite (ics_aux_ok (interp_vl v) c); -Rewrite (ics_aux_ok (interp_vl v0) c0); Simpl; Auto. -Save. - -Lemma monom_insert_ok: (a:A)(l:varlist)(s:canonical_sum) - (Aequiv (interp_setcs (monom_insert a l s)) - (Aplus (Amult a (interp_vl l)) (interp_setcs s))). +simple induction x; simpl in |- *. +trivial. + +simple induction y; simpl in |- *; intros. +eauto. + +generalize (varlist_eq_prop v v0). +elim (varlist_eq v v0). +intros; rewrite (H1 I). +simpl in |- *. +rewrite (ics_aux_ok (interp_m a v0) c). +rewrite (ics_aux_ok (interp_m a0 v0) c0). +rewrite (ics_aux_ok (interp_m (Aplus a a0) v0) (canonical_sum_merge c c0)). +rewrite (H c0). +rewrite (interp_m_ok (Aplus a a0) v0). +rewrite (interp_m_ok a v0). +rewrite (interp_m_ok a0 v0). +setoid_replace (Amult (Aplus a a0) (interp_vl v0)) with + (Aplus (Amult a (interp_vl v0)) (Amult a0 (interp_vl v0))). +setoid_replace + (Aplus (Aplus (Amult a (interp_vl v0)) (Amult a0 (interp_vl v0))) + (Aplus (interp_setcs c) (interp_setcs c0))) with + (Aplus (Amult a (interp_vl v0)) + (Aplus (Amult a0 (interp_vl v0)) + (Aplus (interp_setcs c) (interp_setcs c0)))). +setoid_replace + (Aplus (Aplus (Amult a (interp_vl v0)) (interp_setcs c)) + (Aplus (Amult a0 (interp_vl v0)) (interp_setcs c0))) with + (Aplus (Amult a (interp_vl v0)) + (Aplus (interp_setcs c) + (Aplus (Amult a0 (interp_vl v0)) (interp_setcs c0)))). +auto. + +elim (varlist_lt v v0); simpl in |- *. +intro. +rewrite + (ics_aux_ok (interp_m a v) (canonical_sum_merge c (Cons_monom a0 v0 c0))) + . +rewrite (ics_aux_ok (interp_m a v) c). +rewrite (ics_aux_ok (interp_m a0 v0) c0). +rewrite (H (Cons_monom a0 v0 c0)); simpl in |- *. +rewrite (ics_aux_ok (interp_m a0 v0) c0); auto. + +intro. +rewrite + (ics_aux_ok (interp_m a0 v0) + ((fix csm_aux (s2:canonical_sum) : canonical_sum := + match s2 with + | Nil_monom => Cons_monom a v c + | Cons_monom c2 l2 t2 => + if varlist_eq v l2 + then Cons_monom (Aplus a c2) v (canonical_sum_merge c t2) + else + if varlist_lt v l2 + then Cons_monom a v (canonical_sum_merge c s2) + else Cons_monom c2 l2 (csm_aux t2) + | Cons_varlist l2 t2 => + if varlist_eq v l2 + then Cons_monom (Aplus a Aone) v (canonical_sum_merge c t2) + else + if varlist_lt v l2 + then Cons_monom a v (canonical_sum_merge c s2) + else Cons_varlist l2 (csm_aux t2) + end) c0)). +rewrite H0. +rewrite (ics_aux_ok (interp_m a v) c); + rewrite (ics_aux_ok (interp_m a0 v0) c0); simpl in |- *; + auto. + +generalize (varlist_eq_prop v v0). +elim (varlist_eq v v0). +intros; rewrite (H1 I). +simpl in |- *. +rewrite (ics_aux_ok (interp_m (Aplus a Aone) v0) (canonical_sum_merge c c0)); + rewrite (ics_aux_ok (interp_m a v0) c); + rewrite (ics_aux_ok (interp_vl v0) c0). +rewrite (H c0). +rewrite (interp_m_ok (Aplus a Aone) v0). +rewrite (interp_m_ok a v0). +setoid_replace (Amult (Aplus a Aone) (interp_vl v0)) with + (Aplus (Amult a (interp_vl v0)) (Amult Aone (interp_vl v0))). +setoid_replace + (Aplus (Aplus (Amult a (interp_vl v0)) (Amult Aone (interp_vl v0))) + (Aplus (interp_setcs c) (interp_setcs c0))) with + (Aplus (Amult a (interp_vl v0)) + (Aplus (Amult Aone (interp_vl v0)) + (Aplus (interp_setcs c) (interp_setcs c0)))). +setoid_replace + (Aplus (Aplus (Amult a (interp_vl v0)) (interp_setcs c)) + (Aplus (interp_vl v0) (interp_setcs c0))) with + (Aplus (Amult a (interp_vl v0)) + (Aplus (interp_setcs c) (Aplus (interp_vl v0) (interp_setcs c0)))). +setoid_replace (Amult Aone (interp_vl v0)) with (interp_vl v0). +auto. + +elim (varlist_lt v v0); simpl in |- *. +intro. +rewrite + (ics_aux_ok (interp_m a v) (canonical_sum_merge c (Cons_varlist v0 c0))) + ; rewrite (ics_aux_ok (interp_m a v) c); + rewrite (ics_aux_ok (interp_vl v0) c0). +rewrite (H (Cons_varlist v0 c0)); simpl in |- *. +rewrite (ics_aux_ok (interp_vl v0) c0). +auto. + +intro. +rewrite + (ics_aux_ok (interp_vl v0) + ((fix csm_aux (s2:canonical_sum) : canonical_sum := + match s2 with + | Nil_monom => Cons_monom a v c + | Cons_monom c2 l2 t2 => + if varlist_eq v l2 + then Cons_monom (Aplus a c2) v (canonical_sum_merge c t2) + else + if varlist_lt v l2 + then Cons_monom a v (canonical_sum_merge c s2) + else Cons_monom c2 l2 (csm_aux t2) + | Cons_varlist l2 t2 => + if varlist_eq v l2 + then Cons_monom (Aplus a Aone) v (canonical_sum_merge c t2) + else + if varlist_lt v l2 + then Cons_monom a v (canonical_sum_merge c s2) + else Cons_varlist l2 (csm_aux t2) + end) c0)); rewrite H0. +rewrite (ics_aux_ok (interp_m a v) c); rewrite (ics_aux_ok (interp_vl v0) c0); + simpl in |- *. +auto. + +simple induction y; simpl in |- *; intros. +trivial. + +generalize (varlist_eq_prop v v0). +elim (varlist_eq v v0). +intros; rewrite (H1 I). +simpl in |- *. +rewrite (ics_aux_ok (interp_m (Aplus Aone a) v0) (canonical_sum_merge c c0)); + rewrite (ics_aux_ok (interp_vl v0) c); + rewrite (ics_aux_ok (interp_m a v0) c0); rewrite (H c0). +rewrite (interp_m_ok (Aplus Aone a) v0); rewrite (interp_m_ok a v0). +setoid_replace (Amult (Aplus Aone a) (interp_vl v0)) with + (Aplus (Amult Aone (interp_vl v0)) (Amult a (interp_vl v0))); + setoid_replace + (Aplus (Aplus (Amult Aone (interp_vl v0)) (Amult a (interp_vl v0))) + (Aplus (interp_setcs c) (interp_setcs c0))) with + (Aplus (Amult Aone (interp_vl v0)) + (Aplus (Amult a (interp_vl v0)) + (Aplus (interp_setcs c) (interp_setcs c0)))); + setoid_replace + (Aplus (Aplus (interp_vl v0) (interp_setcs c)) + (Aplus (Amult a (interp_vl v0)) (interp_setcs c0))) with + (Aplus (interp_vl v0) + (Aplus (interp_setcs c) + (Aplus (Amult a (interp_vl v0)) (interp_setcs c0)))). +auto. + +elim (varlist_lt v v0); simpl in |- *; intros. +rewrite + (ics_aux_ok (interp_vl v) (canonical_sum_merge c (Cons_monom a v0 c0))) + ; rewrite (ics_aux_ok (interp_vl v) c); + rewrite (ics_aux_ok (interp_m a v0) c0). +rewrite (H (Cons_monom a v0 c0)); simpl in |- *. +rewrite (ics_aux_ok (interp_m a v0) c0); auto. + +rewrite + (ics_aux_ok (interp_m a v0) + ((fix csm_aux2 (s2:canonical_sum) : canonical_sum := + match s2 with + | Nil_monom => Cons_varlist v c + | Cons_monom c2 l2 t2 => + if varlist_eq v l2 + then Cons_monom (Aplus Aone c2) v (canonical_sum_merge c t2) + else + if varlist_lt v l2 + then Cons_varlist v (canonical_sum_merge c s2) + else Cons_monom c2 l2 (csm_aux2 t2) + | Cons_varlist l2 t2 => + if varlist_eq v l2 + then Cons_monom (Aplus Aone Aone) v (canonical_sum_merge c t2) + else + if varlist_lt v l2 + then Cons_varlist v (canonical_sum_merge c s2) + else Cons_varlist l2 (csm_aux2 t2) + end) c0)); rewrite H0. +rewrite (ics_aux_ok (interp_vl v) c); rewrite (ics_aux_ok (interp_m a v0) c0); + simpl in |- *; auto. + +generalize (varlist_eq_prop v v0). +elim (varlist_eq v v0); intros. +rewrite (H1 I); simpl in |- *. +rewrite + (ics_aux_ok (interp_m (Aplus Aone Aone) v0) (canonical_sum_merge c c0)) + ; rewrite (ics_aux_ok (interp_vl v0) c); + rewrite (ics_aux_ok (interp_vl v0) c0); rewrite (H c0). +rewrite (interp_m_ok (Aplus Aone Aone) v0). +setoid_replace (Amult (Aplus Aone Aone) (interp_vl v0)) with + (Aplus (Amult Aone (interp_vl v0)) (Amult Aone (interp_vl v0))); + setoid_replace + (Aplus (Aplus (Amult Aone (interp_vl v0)) (Amult Aone (interp_vl v0))) + (Aplus (interp_setcs c) (interp_setcs c0))) with + (Aplus (Amult Aone (interp_vl v0)) + (Aplus (Amult Aone (interp_vl v0)) + (Aplus (interp_setcs c) (interp_setcs c0)))); + setoid_replace + (Aplus (Aplus (interp_vl v0) (interp_setcs c)) + (Aplus (interp_vl v0) (interp_setcs c0))) with + (Aplus (interp_vl v0) + (Aplus (interp_setcs c) (Aplus (interp_vl v0) (interp_setcs c0)))). +setoid_replace (Amult Aone (interp_vl v0)) with (interp_vl v0); auto. + +elim (varlist_lt v v0); simpl in |- *. +rewrite + (ics_aux_ok (interp_vl v) (canonical_sum_merge c (Cons_varlist v0 c0))) + ; rewrite (ics_aux_ok (interp_vl v) c); + rewrite (ics_aux_ok (interp_vl v0) c0); rewrite (H (Cons_varlist v0 c0)); + simpl in |- *. +rewrite (ics_aux_ok (interp_vl v0) c0); auto. + +rewrite + (ics_aux_ok (interp_vl v0) + ((fix csm_aux2 (s2:canonical_sum) : canonical_sum := + match s2 with + | Nil_monom => Cons_varlist v c + | Cons_monom c2 l2 t2 => + if varlist_eq v l2 + then Cons_monom (Aplus Aone c2) v (canonical_sum_merge c t2) + else + if varlist_lt v l2 + then Cons_varlist v (canonical_sum_merge c s2) + else Cons_monom c2 l2 (csm_aux2 t2) + | Cons_varlist l2 t2 => + if varlist_eq v l2 + then Cons_monom (Aplus Aone Aone) v (canonical_sum_merge c t2) + else + if varlist_lt v l2 + then Cons_varlist v (canonical_sum_merge c s2) + else Cons_varlist l2 (csm_aux2 t2) + end) c0)); rewrite H0. +rewrite (ics_aux_ok (interp_vl v) c); rewrite (ics_aux_ok (interp_vl v0) c0); + simpl in |- *; auto. +Qed. + +Lemma monom_insert_ok : + forall (a:A) (l:varlist) (s:canonical_sum), + Aequiv (interp_setcs (monom_insert a l s)) + (Aplus (Amult a (interp_vl l)) (interp_setcs s)). Proof. -Induction s; Intros. -Simpl; Rewrite (interp_m_ok a l); Trivial. - -Simpl; Generalize (varlist_eq_prop l v); Elim (varlist_eq l v). -Intro Hr; Rewrite (Hr I); Simpl. -Rewrite (ics_aux_ok (interp_m (Aplus a a0) v) c); -Rewrite (ics_aux_ok (interp_m a0 v) c). -Rewrite (interp_m_ok (Aplus a a0) v); -Rewrite (interp_m_ok a0 v). -Setoid_replace (Amult (Aplus a a0) (interp_vl v)) - with (Aplus (Amult a (interp_vl v)) (Amult a0 (interp_vl v))). -Auto. - -Elim (varlist_lt l v); Simpl; Intros. -Rewrite (ics_aux_ok (interp_m a0 v) c). -Rewrite (interp_m_ok a0 v); Rewrite (interp_m_ok a l). -Auto. - -Rewrite (ics_aux_ok (interp_m a0 v) (monom_insert a l c)); -Rewrite (ics_aux_ok (interp_m a0 v) c); Rewrite H. -Auto. - -Simpl. -Generalize (varlist_eq_prop l v); Elim (varlist_eq l v). -Intro Hr; Rewrite (Hr I); Simpl. -Rewrite (ics_aux_ok (interp_m (Aplus a Aone) v) c); -Rewrite (ics_aux_ok (interp_vl v) c). -Rewrite (interp_m_ok (Aplus a Aone) v). -Setoid_replace (Amult (Aplus a Aone) (interp_vl v)) - with (Aplus (Amult a (interp_vl v)) (Amult Aone (interp_vl v))). -Setoid_replace (Amult Aone (interp_vl v)) with (interp_vl v). -Auto. - -Elim (varlist_lt l v); Simpl; Intros; Auto. -Rewrite (ics_aux_ok (interp_vl v) (monom_insert a l c)); -Rewrite H. -Rewrite (ics_aux_ok (interp_vl v) c); Auto. -Save. +simple induction s; intros. +simpl in |- *; rewrite (interp_m_ok a l); trivial. + +simpl in |- *; generalize (varlist_eq_prop l v); elim (varlist_eq l v). +intro Hr; rewrite (Hr I); simpl in |- *. +rewrite (ics_aux_ok (interp_m (Aplus a a0) v) c); + rewrite (ics_aux_ok (interp_m a0 v) c). +rewrite (interp_m_ok (Aplus a a0) v); rewrite (interp_m_ok a0 v). +setoid_replace (Amult (Aplus a a0) (interp_vl v)) with + (Aplus (Amult a (interp_vl v)) (Amult a0 (interp_vl v))). +auto. + +elim (varlist_lt l v); simpl in |- *; intros. +rewrite (ics_aux_ok (interp_m a0 v) c). +rewrite (interp_m_ok a0 v); rewrite (interp_m_ok a l). +auto. + +rewrite (ics_aux_ok (interp_m a0 v) (monom_insert a l c)); + rewrite (ics_aux_ok (interp_m a0 v) c); rewrite H. +auto. + +simpl in |- *. +generalize (varlist_eq_prop l v); elim (varlist_eq l v). +intro Hr; rewrite (Hr I); simpl in |- *. +rewrite (ics_aux_ok (interp_m (Aplus a Aone) v) c); + rewrite (ics_aux_ok (interp_vl v) c). +rewrite (interp_m_ok (Aplus a Aone) v). +setoid_replace (Amult (Aplus a Aone) (interp_vl v)) with + (Aplus (Amult a (interp_vl v)) (Amult Aone (interp_vl v))). +setoid_replace (Amult Aone (interp_vl v)) with (interp_vl v). +auto. + +elim (varlist_lt l v); simpl in |- *; intros; auto. +rewrite (ics_aux_ok (interp_vl v) (monom_insert a l c)); rewrite H. +rewrite (ics_aux_ok (interp_vl v) c); auto. +Qed. Lemma varlist_insert_ok : - (l:varlist)(s:canonical_sum) - (Aequiv (interp_setcs (varlist_insert l s)) - (Aplus (interp_vl l) (interp_setcs s))). + forall (l:varlist) (s:canonical_sum), + Aequiv (interp_setcs (varlist_insert l s)) + (Aplus (interp_vl l) (interp_setcs s)). Proof. -Induction s; Simpl; Intros. -Trivial. - -Generalize (varlist_eq_prop l v); Elim (varlist_eq l v). -Intro Hr; Rewrite (Hr I); Simpl. -Rewrite (ics_aux_ok (interp_m (Aplus Aone a) v) c); -Rewrite (ics_aux_ok (interp_m a v) c). -Rewrite (interp_m_ok (Aplus Aone a) v); -Rewrite (interp_m_ok a v). -Setoid_replace (Amult (Aplus Aone a) (interp_vl v)) - with (Aplus (Amult Aone (interp_vl v)) (Amult a (interp_vl v))). -Setoid_replace (Amult Aone (interp_vl v)) with (interp_vl v); Auto. - -Elim (varlist_lt l v); Simpl; Intros; Auto. -Rewrite (ics_aux_ok (interp_m a v) (varlist_insert l c)); -Rewrite (ics_aux_ok (interp_m a v) c). -Rewrite (interp_m_ok a v). -Rewrite H; Auto. - -Generalize (varlist_eq_prop l v); Elim (varlist_eq l v). -Intro Hr; Rewrite (Hr I); Simpl. -Rewrite (ics_aux_ok (interp_m (Aplus Aone Aone) v) c); -Rewrite (ics_aux_ok (interp_vl v) c). -Rewrite (interp_m_ok (Aplus Aone Aone) v). -Setoid_replace (Amult (Aplus Aone Aone) (interp_vl v)) - with (Aplus (Amult Aone (interp_vl v)) (Amult Aone (interp_vl v))). -Setoid_replace (Amult Aone (interp_vl v)) with (interp_vl v); Auto. - -Elim (varlist_lt l v); Simpl; Intros; Auto. -Rewrite (ics_aux_ok (interp_vl v) (varlist_insert l c)). -Rewrite H. -Rewrite (ics_aux_ok (interp_vl v) c); Auto. -Save. - -Lemma canonical_sum_scalar_ok : (a:A)(s:canonical_sum) - (Aequiv (interp_setcs (canonical_sum_scalar a s)) (Amult a (interp_setcs s))). +simple induction s; simpl in |- *; intros. +trivial. + +generalize (varlist_eq_prop l v); elim (varlist_eq l v). +intro Hr; rewrite (Hr I); simpl in |- *. +rewrite (ics_aux_ok (interp_m (Aplus Aone a) v) c); + rewrite (ics_aux_ok (interp_m a v) c). +rewrite (interp_m_ok (Aplus Aone a) v); rewrite (interp_m_ok a v). +setoid_replace (Amult (Aplus Aone a) (interp_vl v)) with + (Aplus (Amult Aone (interp_vl v)) (Amult a (interp_vl v))). +setoid_replace (Amult Aone (interp_vl v)) with (interp_vl v); auto. + +elim (varlist_lt l v); simpl in |- *; intros; auto. +rewrite (ics_aux_ok (interp_m a v) (varlist_insert l c)); + rewrite (ics_aux_ok (interp_m a v) c). +rewrite (interp_m_ok a v). +rewrite H; auto. + +generalize (varlist_eq_prop l v); elim (varlist_eq l v). +intro Hr; rewrite (Hr I); simpl in |- *. +rewrite (ics_aux_ok (interp_m (Aplus Aone Aone) v) c); + rewrite (ics_aux_ok (interp_vl v) c). +rewrite (interp_m_ok (Aplus Aone Aone) v). +setoid_replace (Amult (Aplus Aone Aone) (interp_vl v)) with + (Aplus (Amult Aone (interp_vl v)) (Amult Aone (interp_vl v))). +setoid_replace (Amult Aone (interp_vl v)) with (interp_vl v); auto. + +elim (varlist_lt l v); simpl in |- *; intros; auto. +rewrite (ics_aux_ok (interp_vl v) (varlist_insert l c)). +rewrite H. +rewrite (ics_aux_ok (interp_vl v) c); auto. +Qed. + +Lemma canonical_sum_scalar_ok : + forall (a:A) (s:canonical_sum), + Aequiv (interp_setcs (canonical_sum_scalar a s)) + (Amult a (interp_setcs s)). Proof. -Induction s; Simpl; Intros. -Trivial. - -Rewrite (ics_aux_ok (interp_m (Amult a a0) v) - (canonical_sum_scalar a c)); -Rewrite (ics_aux_ok (interp_m a0 v) c). -Rewrite (interp_m_ok (Amult a a0) v); -Rewrite (interp_m_ok a0 v). -Rewrite H. -Setoid_replace (Amult a (Aplus (Amult a0 (interp_vl v)) (interp_setcs c))) +simple induction s; simpl in |- *; intros. +trivial. + +rewrite (ics_aux_ok (interp_m (Amult a a0) v) (canonical_sum_scalar a c)); + rewrite (ics_aux_ok (interp_m a0 v) c). +rewrite (interp_m_ok (Amult a a0) v); rewrite (interp_m_ok a0 v). +rewrite H. +setoid_replace (Amult a (Aplus (Amult a0 (interp_vl v)) (interp_setcs c))) with (Aplus (Amult a (Amult a0 (interp_vl v))) (Amult a (interp_setcs c))). -Auto. - -Rewrite (ics_aux_ok (interp_m a v) (canonical_sum_scalar a c)); -Rewrite (ics_aux_ok (interp_vl v) c); Rewrite H. -Rewrite (interp_m_ok a v). -Auto. -Save. - -Lemma canonical_sum_scalar2_ok : (l:varlist; s:canonical_sum) - (Aequiv (interp_setcs (canonical_sum_scalar2 l s)) (Amult (interp_vl l) (interp_setcs s))). +auto. + +rewrite (ics_aux_ok (interp_m a v) (canonical_sum_scalar a c)); + rewrite (ics_aux_ok (interp_vl v) c); rewrite H. +rewrite (interp_m_ok a v). +auto. +Qed. + +Lemma canonical_sum_scalar2_ok : + forall (l:varlist) (s:canonical_sum), + Aequiv (interp_setcs (canonical_sum_scalar2 l s)) + (Amult (interp_vl l) (interp_setcs s)). Proof. -Induction s; Simpl; Intros; Auto. -Rewrite (monom_insert_ok a (varlist_merge l v) - (canonical_sum_scalar2 l c)). -Rewrite (ics_aux_ok (interp_m a v) c). -Rewrite (interp_m_ok a v). -Rewrite H. -Rewrite (varlist_merge_ok l v). -Setoid_replace (Amult (interp_vl l) - (Aplus (Amult a (interp_vl v)) (interp_setcs c))) - with (Aplus (Amult (interp_vl l) (Amult a (interp_vl v))) - (Amult (interp_vl l) (interp_setcs c))). -Auto. - -Rewrite (varlist_insert_ok (varlist_merge l v) - (canonical_sum_scalar2 l c)). -Rewrite (ics_aux_ok (interp_vl v) c). -Rewrite H. -Rewrite (varlist_merge_ok l v). -Auto. -Save. - -Lemma canonical_sum_scalar3_ok : (c:A; l:varlist; s:canonical_sum) - (Aequiv (interp_setcs (canonical_sum_scalar3 c l s)) (Amult c (Amult (interp_vl l) (interp_setcs s)))). +simple induction s; simpl in |- *; intros; auto. +rewrite (monom_insert_ok a (varlist_merge l v) (canonical_sum_scalar2 l c)). +rewrite (ics_aux_ok (interp_m a v) c). +rewrite (interp_m_ok a v). +rewrite H. +rewrite (varlist_merge_ok l v). +setoid_replace + (Amult (interp_vl l) (Aplus (Amult a (interp_vl v)) (interp_setcs c))) with + (Aplus (Amult (interp_vl l) (Amult a (interp_vl v))) + (Amult (interp_vl l) (interp_setcs c))). +auto. + +rewrite (varlist_insert_ok (varlist_merge l v) (canonical_sum_scalar2 l c)). +rewrite (ics_aux_ok (interp_vl v) c). +rewrite H. +rewrite (varlist_merge_ok l v). +auto. +Qed. + +Lemma canonical_sum_scalar3_ok : + forall (c:A) (l:varlist) (s:canonical_sum), + Aequiv (interp_setcs (canonical_sum_scalar3 c l s)) + (Amult c (Amult (interp_vl l) (interp_setcs s))). Proof. -Induction s; Simpl; Intros. -Rewrite (SSR_mult_zero_right S T (interp_vl l)). -Auto. - -Rewrite (monom_insert_ok (Amult c a) (varlist_merge l v) - (canonical_sum_scalar3 c l c0)). -Rewrite (ics_aux_ok (interp_m a v) c0). -Rewrite (interp_m_ok a v). -Rewrite H. -Rewrite (varlist_merge_ok l v). -Setoid_replace (Amult (interp_vl l) - (Aplus (Amult a (interp_vl v)) (interp_setcs c0))) - with (Aplus (Amult (interp_vl l) (Amult a (interp_vl v))) - (Amult (interp_vl l) (interp_setcs c0))). -Setoid_replace (Amult c - (Aplus (Amult (interp_vl l) (Amult a (interp_vl v))) - (Amult (interp_vl l) (interp_setcs c0)))) - with (Aplus (Amult c (Amult (interp_vl l) (Amult a (interp_vl v)))) - (Amult c (Amult (interp_vl l) (interp_setcs c0)))). -Setoid_replace (Amult (Amult c a) (Amult (interp_vl l) (interp_vl v))) - with (Amult c (Amult a (Amult (interp_vl l) (interp_vl v)))). -Auto. - -Rewrite (monom_insert_ok c (varlist_merge l v) - (canonical_sum_scalar3 c l c0)). -Rewrite (ics_aux_ok (interp_vl v) c0). -Rewrite H. -Rewrite (varlist_merge_ok l v). -Setoid_replace (Aplus (Amult c (Amult (interp_vl l) (interp_vl v))) - (Amult c (Amult (interp_vl l) (interp_setcs c0)))) - with (Amult c - (Aplus (Amult (interp_vl l) (interp_vl v)) - (Amult (interp_vl l) (interp_setcs c0)))). -Auto. -Save. - -Lemma canonical_sum_prod_ok : (x,y:canonical_sum) - (Aequiv (interp_setcs (canonical_sum_prod x y)) (Amult (interp_setcs x) (interp_setcs y))). +simple induction s; simpl in |- *; intros. +rewrite (SSR_mult_zero_right S T (interp_vl l)). +auto. + +rewrite + (monom_insert_ok (Amult c a) (varlist_merge l v) + (canonical_sum_scalar3 c l c0)). +rewrite (ics_aux_ok (interp_m a v) c0). +rewrite (interp_m_ok a v). +rewrite H. +rewrite (varlist_merge_ok l v). +setoid_replace + (Amult (interp_vl l) (Aplus (Amult a (interp_vl v)) (interp_setcs c0))) with + (Aplus (Amult (interp_vl l) (Amult a (interp_vl v))) + (Amult (interp_vl l) (interp_setcs c0))). +setoid_replace + (Amult c + (Aplus (Amult (interp_vl l) (Amult a (interp_vl v))) + (Amult (interp_vl l) (interp_setcs c0)))) with + (Aplus (Amult c (Amult (interp_vl l) (Amult a (interp_vl v)))) + (Amult c (Amult (interp_vl l) (interp_setcs c0)))). +setoid_replace (Amult (Amult c a) (Amult (interp_vl l) (interp_vl v))) with + (Amult c (Amult a (Amult (interp_vl l) (interp_vl v)))). +auto. + +rewrite + (monom_insert_ok c (varlist_merge l v) (canonical_sum_scalar3 c l c0)) + . +rewrite (ics_aux_ok (interp_vl v) c0). +rewrite H. +rewrite (varlist_merge_ok l v). +setoid_replace + (Aplus (Amult c (Amult (interp_vl l) (interp_vl v))) + (Amult c (Amult (interp_vl l) (interp_setcs c0)))) with + (Amult c + (Aplus (Amult (interp_vl l) (interp_vl v)) + (Amult (interp_vl l) (interp_setcs c0)))). +auto. +Qed. + +Lemma canonical_sum_prod_ok : + forall x y:canonical_sum, + Aequiv (interp_setcs (canonical_sum_prod x y)) + (Amult (interp_setcs x) (interp_setcs y)). Proof. -Induction x; Simpl; Intros. -Trivial. - -Rewrite (canonical_sum_merge_ok (canonical_sum_scalar3 a v y) - (canonical_sum_prod c y)). -Rewrite (canonical_sum_scalar3_ok a v y). -Rewrite (ics_aux_ok (interp_m a v) c). -Rewrite (interp_m_ok a v). -Rewrite (H y). -Setoid_replace (Amult a (Amult (interp_vl v) (interp_setcs y))) - with (Amult (Amult a (interp_vl v)) (interp_setcs y)). -Setoid_replace (Amult (Aplus (Amult a (interp_vl v)) (interp_setcs c)) - (interp_setcs y)) - with (Aplus (Amult (Amult a (interp_vl v)) (interp_setcs y)) - (Amult (interp_setcs c) (interp_setcs y))). -Trivial. - -Rewrite (canonical_sum_merge_ok (canonical_sum_scalar2 v y) - (canonical_sum_prod c y)). -Rewrite (canonical_sum_scalar2_ok v y). -Rewrite (ics_aux_ok (interp_vl v) c). -Rewrite (H y). -Trivial. -Save. - -Theorem setspolynomial_normalize_ok : (p:setspolynomial) - (Aequiv (interp_setcs (setspolynomial_normalize p)) (interp_setsp p)). +simple induction x; simpl in |- *; intros. +trivial. + +rewrite + (canonical_sum_merge_ok (canonical_sum_scalar3 a v y) + (canonical_sum_prod c y)). +rewrite (canonical_sum_scalar3_ok a v y). +rewrite (ics_aux_ok (interp_m a v) c). +rewrite (interp_m_ok a v). +rewrite (H y). +setoid_replace (Amult a (Amult (interp_vl v) (interp_setcs y))) with + (Amult (Amult a (interp_vl v)) (interp_setcs y)). +setoid_replace + (Amult (Aplus (Amult a (interp_vl v)) (interp_setcs c)) (interp_setcs y)) + with + (Aplus (Amult (Amult a (interp_vl v)) (interp_setcs y)) + (Amult (interp_setcs c) (interp_setcs y))). +trivial. + +rewrite + (canonical_sum_merge_ok (canonical_sum_scalar2 v y) (canonical_sum_prod c y)) + . +rewrite (canonical_sum_scalar2_ok v y). +rewrite (ics_aux_ok (interp_vl v) c). +rewrite (H y). +trivial. +Qed. + +Theorem setspolynomial_normalize_ok : + forall p:setspolynomial, + Aequiv (interp_setcs (setspolynomial_normalize p)) (interp_setsp p). Proof. -Induction p; Simpl; Intros; Trivial. -Rewrite (canonical_sum_merge_ok (setspolynomial_normalize s) - (setspolynomial_normalize s0)). -Rewrite H; Rewrite H0; Trivial. - -Rewrite (canonical_sum_prod_ok (setspolynomial_normalize s) - (setspolynomial_normalize s0)). -Rewrite H; Rewrite H0; Trivial. -Save. - -Lemma canonical_sum_simplify_ok : (s:canonical_sum) - (Aequiv (interp_setcs (canonical_sum_simplify s)) (interp_setcs s)). +simple induction p; simpl in |- *; intros; trivial. +rewrite + (canonical_sum_merge_ok (setspolynomial_normalize s) + (setspolynomial_normalize s0)). +rewrite H; rewrite H0; trivial. + +rewrite + (canonical_sum_prod_ok (setspolynomial_normalize s) + (setspolynomial_normalize s0)). +rewrite H; rewrite H0; trivial. +Qed. + +Lemma canonical_sum_simplify_ok : + forall s:canonical_sum, + Aequiv (interp_setcs (canonical_sum_simplify s)) (interp_setcs s). Proof. -Induction s; Simpl; Intros. -Trivial. - -Generalize (SSR_eq_prop T 9!a 10!Azero). -Elim (Aeq a Azero). -Simpl. -Intros. -Rewrite (ics_aux_ok (interp_m a v) c). -Rewrite (interp_m_ok a v). -Rewrite (H0 I). -Setoid_replace (Amult Azero (interp_vl v)) with Azero. -Rewrite H. -Trivial. - -Intros; Simpl. -Generalize (SSR_eq_prop T 9!a 10!Aone). -Elim (Aeq a Aone). -Intros. -Rewrite (ics_aux_ok (interp_m a v) c). -Rewrite (interp_m_ok a v). -Rewrite (H1 I). -Simpl. -Rewrite (ics_aux_ok (interp_vl v) (canonical_sum_simplify c)). -Rewrite H. -Auto. - -Simpl. -Intros. -Rewrite (ics_aux_ok (interp_m a v) (canonical_sum_simplify c)). -Rewrite (ics_aux_ok (interp_m a v) c). -Rewrite H; Trivial. - -Rewrite (ics_aux_ok (interp_vl v) (canonical_sum_simplify c)). -Rewrite H. -Auto. -Save. - -Theorem setspolynomial_simplify_ok : (p:setspolynomial) - (Aequiv (interp_setcs (setspolynomial_simplify p)) (interp_setsp p)). +simple induction s; simpl in |- *; intros. +trivial. + +generalize (SSR_eq_prop T a Azero). +elim (Aeq a Azero). +simpl in |- *. +intros. +rewrite (ics_aux_ok (interp_m a v) c). +rewrite (interp_m_ok a v). +rewrite (H0 I). +setoid_replace (Amult Azero (interp_vl v)) with Azero. +rewrite H. +trivial. + +intros; simpl in |- *. +generalize (SSR_eq_prop T a Aone). +elim (Aeq a Aone). +intros. +rewrite (ics_aux_ok (interp_m a v) c). +rewrite (interp_m_ok a v). +rewrite (H1 I). +simpl in |- *. +rewrite (ics_aux_ok (interp_vl v) (canonical_sum_simplify c)). +rewrite H. +auto. + +simpl in |- *. +intros. +rewrite (ics_aux_ok (interp_m a v) (canonical_sum_simplify c)). +rewrite (ics_aux_ok (interp_m a v) c). +rewrite H; trivial. + +rewrite (ics_aux_ok (interp_vl v) (canonical_sum_simplify c)). +rewrite H. +auto. +Qed. + +Theorem setspolynomial_simplify_ok : + forall p:setspolynomial, + Aequiv (interp_setcs (setspolynomial_simplify p)) (interp_setsp p). Proof. -Intro. -Unfold setspolynomial_simplify. -Rewrite (canonical_sum_simplify_ok (setspolynomial_normalize p)). -Exact (setspolynomial_normalize_ok p). -Save. +intro. +unfold setspolynomial_simplify in |- *. +rewrite (canonical_sum_simplify_ok (setspolynomial_normalize p)). +exact (setspolynomial_normalize_ok p). +Qed. End semi_setoid_rings. -Implicits Cons_varlist. -Implicits Cons_monom. -Implicits SetSPconst. -Implicits SetSPplus. -Implicits SetSPmult. +Implicit Arguments Cons_varlist. +Implicit Arguments Cons_monom. +Implicit Arguments SetSPconst. +Implicit Arguments SetSPplus. +Implicit Arguments SetSPmult. @@ -1008,134 +998,140 @@ Section setoid_rings. Set Implicit Arguments. -Variable vm : (varmap A). -Variable T : (Setoid_Ring_Theory Aequiv Aplus Amult Aone Azero Aopp Aeq). - -Hint STh_plus_sym_T := Resolve (STh_plus_sym T). -Hint STh_plus_assoc_T := Resolve (STh_plus_assoc T). -Hint STh_plus_assoc2_T := Resolve (STh_plus_assoc2 S T). -Hint STh_mult_sym_T := Resolve (STh_mult_sym T). -Hint STh_mult_assoc_T := Resolve (STh_mult_assoc T). -Hint STh_mult_assoc2_T := Resolve (STh_mult_assoc2 S T). -Hint STh_plus_zero_left_T := Resolve (STh_plus_zero_left T). -Hint STh_plus_zero_left2_T := Resolve (STh_plus_zero_left2 S T). -Hint STh_mult_one_left_T := Resolve (STh_mult_one_left T). -Hint STh_mult_one_left2_T := Resolve (STh_mult_one_left2 S T). -Hint STh_mult_zero_left_T := Resolve (STh_mult_zero_left S plus_morph mult_morph T). -Hint STh_mult_zero_left2_T := Resolve (STh_mult_zero_left2 S plus_morph mult_morph T). -Hint STh_distr_left_T := Resolve (STh_distr_left T). -Hint STh_distr_left2_T := Resolve (STh_distr_left2 S T). -Hint STh_plus_reg_left_T := Resolve (STh_plus_reg_left S plus_morph T). -Hint STh_plus_permute_T := Resolve (STh_plus_permute S plus_morph T). -Hint STh_mult_permute_T := Resolve (STh_mult_permute S mult_morph T). -Hint STh_distr_right_T := Resolve (STh_distr_right S plus_morph T). -Hint STh_distr_right2_T := Resolve (STh_distr_right2 S plus_morph T). -Hint STh_mult_zero_right_T := Resolve (STh_mult_zero_right S plus_morph mult_morph T). -Hint STh_mult_zero_right2_T := Resolve (STh_mult_zero_right2 S plus_morph mult_morph T). -Hint STh_plus_zero_right_T := Resolve (STh_plus_zero_right S T). -Hint STh_plus_zero_right2_T := Resolve (STh_plus_zero_right2 S T). -Hint STh_mult_one_right_T := Resolve (STh_mult_one_right S T). -Hint STh_mult_one_right2_T := Resolve (STh_mult_one_right2 S T). -Hint STh_plus_reg_right_T := Resolve (STh_plus_reg_right S plus_morph T). -Hints Resolve refl_equal sym_equal trans_equal. +Variable vm : varmap A. +Variable T : Setoid_Ring_Theory Aequiv Aplus Amult Aone Azero Aopp Aeq. + +Hint Resolve (STh_plus_comm T). +Hint Resolve (STh_plus_assoc T). +Hint Resolve (STh_plus_assoc2 S T). +Hint Resolve (STh_mult_sym T). +Hint Resolve (STh_mult_assoc T). +Hint Resolve (STh_mult_assoc2 S T). +Hint Resolve (STh_plus_zero_left T). +Hint Resolve (STh_plus_zero_left2 S T). +Hint Resolve (STh_mult_one_left T). +Hint Resolve (STh_mult_one_left2 S T). +Hint Resolve (STh_mult_zero_left S plus_morph mult_morph T). +Hint Resolve (STh_mult_zero_left2 S plus_morph mult_morph T). +Hint Resolve (STh_distr_left T). +Hint Resolve (STh_distr_left2 S T). +Hint Resolve (STh_plus_reg_left S plus_morph T). +Hint Resolve (STh_plus_permute S plus_morph T). +Hint Resolve (STh_mult_permute S mult_morph T). +Hint Resolve (STh_distr_right S plus_morph T). +Hint Resolve (STh_distr_right2 S plus_morph T). +Hint Resolve (STh_mult_zero_right S plus_morph mult_morph T). +Hint Resolve (STh_mult_zero_right2 S plus_morph mult_morph T). +Hint Resolve (STh_plus_zero_right S T). +Hint Resolve (STh_plus_zero_right2 S T). +Hint Resolve (STh_mult_one_right S T). +Hint Resolve (STh_mult_one_right2 S T). +Hint Resolve (STh_plus_reg_right S plus_morph T). +Hint Resolve refl_equal sym_equal trans_equal. (*Hints Resolve refl_eqT sym_eqT trans_eqT.*) -Hints Immediate T. +Hint Immediate T. (*** Definitions *) -Inductive Type setpolynomial := - SetPvar : index -> setpolynomial -| SetPconst : A -> setpolynomial -| SetPplus : setpolynomial -> setpolynomial -> setpolynomial -| SetPmult : setpolynomial -> setpolynomial -> setpolynomial -| SetPopp : setpolynomial -> setpolynomial. - -Fixpoint setpolynomial_normalize [x:setpolynomial] : canonical_sum := - Cases x of - | (SetPplus l r) => (canonical_sum_merge - (setpolynomial_normalize l) - (setpolynomial_normalize r)) - | (SetPmult l r) => (canonical_sum_prod - (setpolynomial_normalize l) - (setpolynomial_normalize r)) - | (SetPconst c) => (Cons_monom c Nil_var Nil_monom) - | (SetPvar i) => (Cons_varlist (Cons_var i Nil_var) Nil_monom) - | (SetPopp p) => (canonical_sum_scalar3 - (Aopp Aone) Nil_var - (setpolynomial_normalize p)) - end. - -Definition setpolynomial_simplify := - [x:setpolynomial](canonical_sum_simplify (setpolynomial_normalize x)). - -Fixpoint setspolynomial_of [x:setpolynomial] : setspolynomial := - Cases x of - | (SetPplus l r) => (SetSPplus (setspolynomial_of l) (setspolynomial_of r)) - | (SetPmult l r) => (SetSPmult (setspolynomial_of l) (setspolynomial_of r)) - | (SetPconst c) => (SetSPconst c) - | (SetPvar i) => (SetSPvar i) - | (SetPopp p) => (SetSPmult (SetSPconst (Aopp Aone)) (setspolynomial_of p)) - end. +Inductive setpolynomial : Type := + | SetPvar : index -> setpolynomial + | SetPconst : A -> setpolynomial + | SetPplus : setpolynomial -> setpolynomial -> setpolynomial + | SetPmult : setpolynomial -> setpolynomial -> setpolynomial + | SetPopp : setpolynomial -> setpolynomial. + +Fixpoint setpolynomial_normalize (x:setpolynomial) : canonical_sum := + match x with + | SetPplus l r => + canonical_sum_merge (setpolynomial_normalize l) + (setpolynomial_normalize r) + | SetPmult l r => + canonical_sum_prod (setpolynomial_normalize l) + (setpolynomial_normalize r) + | SetPconst c => Cons_monom c Nil_var Nil_monom + | SetPvar i => Cons_varlist (Cons_var i Nil_var) Nil_monom + | SetPopp p => + canonical_sum_scalar3 (Aopp Aone) Nil_var (setpolynomial_normalize p) + end. + +Definition setpolynomial_simplify (x:setpolynomial) := + canonical_sum_simplify (setpolynomial_normalize x). + +Fixpoint setspolynomial_of (x:setpolynomial) : setspolynomial := + match x with + | SetPplus l r => SetSPplus (setspolynomial_of l) (setspolynomial_of r) + | SetPmult l r => SetSPmult (setspolynomial_of l) (setspolynomial_of r) + | SetPconst c => SetSPconst c + | SetPvar i => SetSPvar i + | SetPopp p => SetSPmult (SetSPconst (Aopp Aone)) (setspolynomial_of p) + end. (*** Interpretation *) -Fixpoint interp_setp [p:setpolynomial] : A := - Cases p of - | (SetPconst c) => c - | (SetPvar i) => (varmap_find Azero i vm) - | (SetPplus p1 p2) => (Aplus (interp_setp p1) (interp_setp p2)) - | (SetPmult p1 p2) => (Amult (interp_setp p1) (interp_setp p2)) - | (SetPopp p1) => (Aopp (interp_setp p1)) - end. +Fixpoint interp_setp (p:setpolynomial) : A := + match p with + | SetPconst c => c + | SetPvar i => varmap_find Azero i vm + | SetPplus p1 p2 => Aplus (interp_setp p1) (interp_setp p2) + | SetPmult p1 p2 => Amult (interp_setp p1) (interp_setp p2) + | SetPopp p1 => Aopp (interp_setp p1) + end. (*** Properties *) Unset Implicit Arguments. -Lemma setspolynomial_of_ok : (p:setpolynomial) - (Aequiv (interp_setp p) (interp_setsp vm (setspolynomial_of p))). -Induction p; Trivial; Simpl; Intros. -Rewrite H; Rewrite H0; Trivial. -Rewrite H; Rewrite H0; Trivial. -Rewrite H. -Rewrite (STh_opp_mult_left2 S plus_morph mult_morph T Aone - (interp_setsp vm (setspolynomial_of s))). -Rewrite (STh_mult_one_left T - (interp_setsp vm (setspolynomial_of s))). -Trivial. -Save. - -Theorem setpolynomial_normalize_ok : (p:setpolynomial) - (setpolynomial_normalize p) - ==(setspolynomial_normalize (setspolynomial_of p)). -Induction p; Trivial; Simpl; Intros. -Rewrite H; Rewrite H0; Reflexivity. -Rewrite H; Rewrite H0; Reflexivity. -Rewrite H; Simpl. -Elim (canonical_sum_scalar3 (Aopp Aone) Nil_var - (setspolynomial_normalize (setspolynomial_of s))); - [ Reflexivity - | Simpl; Intros; Rewrite H0; Reflexivity - | Simpl; Intros; Rewrite H0; Reflexivity ]. -Save. - -Theorem setpolynomial_simplify_ok : (p:setpolynomial) - (Aequiv (interp_setcs vm (setpolynomial_simplify p)) (interp_setp p)). -Intro. -Unfold setpolynomial_simplify. -Rewrite (setspolynomial_of_ok p). -Rewrite setpolynomial_normalize_ok. -Rewrite (canonical_sum_simplify_ok vm - (Semi_Setoid_Ring_Theory_of A Aequiv S Aplus Amult Aone Azero Aopp - Aeq plus_morph mult_morph T) - (setspolynomial_normalize (setspolynomial_of p))). -Rewrite (setspolynomial_normalize_ok vm - (Semi_Setoid_Ring_Theory_of A Aequiv S Aplus Amult Aone Azero Aopp - Aeq plus_morph mult_morph T) (setspolynomial_of p)). -Trivial. -Save. +Lemma setspolynomial_of_ok : + forall p:setpolynomial, + Aequiv (interp_setp p) (interp_setsp vm (setspolynomial_of p)). +simple induction p; trivial; simpl in |- *; intros. +rewrite H; rewrite H0; trivial. +rewrite H; rewrite H0; trivial. +rewrite H. +rewrite + (STh_opp_mult_left2 S plus_morph mult_morph T Aone + (interp_setsp vm (setspolynomial_of s))). +rewrite (STh_mult_one_left T (interp_setsp vm (setspolynomial_of s))). +trivial. +Qed. + +Theorem setpolynomial_normalize_ok : + forall p:setpolynomial, + setpolynomial_normalize p = setspolynomial_normalize (setspolynomial_of p). +simple induction p; trivial; simpl in |- *; intros. +rewrite H; rewrite H0; reflexivity. +rewrite H; rewrite H0; reflexivity. +rewrite H; simpl in |- *. +elim + (canonical_sum_scalar3 (Aopp Aone) Nil_var + (setspolynomial_normalize (setspolynomial_of s))); + [ reflexivity + | simpl in |- *; intros; rewrite H0; reflexivity + | simpl in |- *; intros; rewrite H0; reflexivity ]. +Qed. + +Theorem setpolynomial_simplify_ok : + forall p:setpolynomial, + Aequiv (interp_setcs vm (setpolynomial_simplify p)) (interp_setp p). +intro. +unfold setpolynomial_simplify in |- *. +rewrite (setspolynomial_of_ok p). +rewrite setpolynomial_normalize_ok. +rewrite + (canonical_sum_simplify_ok vm + (Semi_Setoid_Ring_Theory_of A Aequiv S Aplus Amult Aone Azero Aopp Aeq + plus_morph mult_morph T) + (setspolynomial_normalize (setspolynomial_of p))) + . +rewrite + (setspolynomial_normalize_ok vm + (Semi_Setoid_Ring_Theory_of A Aequiv S Aplus Amult Aone Azero Aopp Aeq + plus_morph mult_morph T) (setspolynomial_of p)) + . +trivial. +Qed. End setoid_rings. -End setoid. +End setoid.
\ No newline at end of file diff --git a/contrib/ring/Setoid_ring_theory.v b/contrib/ring/Setoid_ring_theory.v index d6c19410f..fecdb294b 100644 --- a/contrib/ring/Setoid_ring_theory.v +++ b/contrib/ring/Setoid_ring_theory.v @@ -18,9 +18,9 @@ Section Setoid_rings. Variable A : Type. Variable Aequiv : A -> A -> Prop. -Infix Local "==" Aequiv (at level 5, no associativity). +Infix Local "==" := Aequiv (at level 70, no associativity). -Variable S : (Setoid_Theory A Aequiv). +Variable S : Setoid_Theory A Aequiv. Add Setoid A Aequiv S. @@ -31,390 +31,388 @@ Variable Azero : A. Variable Aopp : A -> A. Variable Aeq : A -> A -> bool. -Infix 4 "+" Aplus V8only 50 (left associativity). -Infix 4 "*" Amult V8only 40 (left associativity). +Infix "+" := Aplus (at level 50, left associativity). +Infix "*" := Amult (at level 40, left associativity). Notation "0" := Azero. Notation "1" := Aone. -Notation "- x" := (Aopp x) (at level 0) V8only. +Notation "- x" := (Aopp x). -Variable plus_morph : (a,a0,a1,a2:A) a == a0 -> a1 == a2 -> a+a1 == a0+a2. -Variable mult_morph : (a,a0,a1,a2:A) a == a0 -> a1 == a2 -> a*a1 == a0*a2. -Variable opp_morph : (a,a0:A) a == a0 -> -a == -a0. +Variable + plus_morph : forall a a0 a1 a2:A, a == a0 -> a1 == a2 -> a + a1 == a0 + a2. +Variable + mult_morph : forall a a0 a1 a2:A, a == a0 -> a1 == a2 -> a * a1 == a0 * a2. +Variable opp_morph : forall a a0:A, a == a0 -> - a == - a0. Add Morphism Aplus : Aplus_ext. -Exact plus_morph. -Save. +exact plus_morph. +Qed. Add Morphism Amult : Amult_ext. -Exact mult_morph. -Save. +exact mult_morph. +Qed. Add Morphism Aopp : Aopp_ext. -Exact opp_morph. -Save. +exact opp_morph. +Qed. Section Theory_of_semi_setoid_rings. -Record Semi_Setoid_Ring_Theory : Prop := -{ SSR_plus_sym : (n,m:A) n + m == m + n; - SSR_plus_assoc : (n,m,p:A) n + (m + p) == (n + m) + p; - SSR_mult_sym : (n,m:A) n*m == m*n; - SSR_mult_assoc : (n,m,p:A) n*(m*p) == (n*m)*p; - SSR_plus_zero_left :(n:A) 0 + n == n; - SSR_mult_one_left : (n:A) 1*n == n; - SSR_mult_zero_left : (n:A) 0*n == 0; - SSR_distr_left : (n,m,p:A) (n + m)*p == n*p + m*p; - SSR_plus_reg_left : (n,m,p:A)n + m == n + p -> m == p; - SSR_eq_prop : (x,y:A) (Is_true (Aeq x y)) -> x == y -}. +Record Semi_Setoid_Ring_Theory : Prop := + {SSR_plus_comm : forall n m:A, n + m == m + n; + SSR_plus_assoc : forall n m p:A, n + (m + p) == n + m + p; + SSR_mult_comm : forall n m:A, n * m == m * n; + SSR_mult_assoc : forall n m p:A, n * (m * p) == n * m * p; + SSR_plus_zero_left : forall n:A, 0 + n == n; + SSR_mult_one_left : forall n:A, 1 * n == n; + SSR_mult_zero_left : forall n:A, 0 * n == 0; + SSR_distr_left : forall n m p:A, (n + m) * p == n * p + m * p; + SSR_plus_reg_left : forall n m p:A, n + m == n + p -> m == p; + SSR_eq_prop : forall x y:A, Is_true (Aeq x y) -> x == y}. Variable T : Semi_Setoid_Ring_Theory. -Local plus_sym := (SSR_plus_sym T). -Local plus_assoc := (SSR_plus_assoc T). -Local mult_sym := ( SSR_mult_sym T). -Local mult_assoc := (SSR_mult_assoc T). -Local plus_zero_left := (SSR_plus_zero_left T). -Local mult_one_left := (SSR_mult_one_left T). -Local mult_zero_left := (SSR_mult_zero_left T). -Local distr_left := (SSR_distr_left T). -Local plus_reg_left := (SSR_plus_reg_left T). -Local equiv_refl := (Seq_refl A Aequiv S). -Local equiv_sym := (Seq_sym A Aequiv S). -Local equiv_trans := (Seq_trans A Aequiv S). - -Hints Resolve plus_sym plus_assoc mult_sym mult_assoc - plus_zero_left mult_one_left mult_zero_left distr_left - plus_reg_left equiv_refl (*equiv_sym*). -Hints Immediate equiv_sym. +Let plus_comm := SSR_plus_comm T. +Let plus_assoc := SSR_plus_assoc T. +Let mult_comm := SSR_mult_comm T. +Let mult_assoc := SSR_mult_assoc T. +Let plus_zero_left := SSR_plus_zero_left T. +Let mult_one_left := SSR_mult_one_left T. +Let mult_zero_left := SSR_mult_zero_left T. +Let distr_left := SSR_distr_left T. +Let plus_reg_left := SSR_plus_reg_left T. +Let equiv_refl := Seq_refl A Aequiv S. +Let equiv_sym := Seq_sym A Aequiv S. +Let equiv_trans := Seq_trans A Aequiv S. + +Hint Resolve plus_comm plus_assoc mult_comm mult_assoc plus_zero_left + mult_one_left mult_zero_left distr_left plus_reg_left + equiv_refl (*equiv_sym*). +Hint Immediate equiv_sym. (* Lemmas whose form is x=y are also provided in form y=x because Auto does not symmetry *) -Lemma SSR_mult_assoc2 : (n,m,p:A) (n * m) * p == n * (m * p). -Auto. Save. - -Lemma SSR_plus_assoc2 : (n,m,p:A) (n + m) + p == n + (m + p). -Auto. Save. - -Lemma SSR_plus_zero_left2 : (n:A) n == 0 + n. -Auto. Save. - -Lemma SSR_mult_one_left2 : (n:A) n == 1*n. -Auto. Save. - -Lemma SSR_mult_zero_left2 : (n:A) 0 == 0*n. -Auto. Save. - -Lemma SSR_distr_left2 : (n,m,p:A) n*p + m*p == (n + m)*p. -Auto. Save. - -Lemma SSR_plus_permute : (n,m,p:A) n+(m+p) == m+(n+p). -Intros. -Rewrite (plus_assoc n m p). -Rewrite (plus_sym n m). -Rewrite <- (plus_assoc m n p). -Trivial. -Save. - -Lemma SSR_mult_permute : (n,m,p:A) n*(m*p) == m*(n*p). -Intros. -Rewrite (mult_assoc n m p). -Rewrite (mult_sym n m). -Rewrite <- (mult_assoc m n p). -Trivial. -Save. - -Hints Resolve SSR_plus_permute SSR_mult_permute. - -Lemma SSR_distr_right : (n,m,p:A) n*(m+p) == (n*m) + (n*p). -Intros. -Rewrite (mult_sym n (Aplus m p)). -Rewrite (mult_sym n m). -Rewrite (mult_sym n p). -Auto. -Save. - -Lemma SSR_distr_right2 : (n,m,p:A) (n*m) + (n*p) == n*(m + p). -Intros. -Apply equiv_sym. -Apply SSR_distr_right. -Save. - -Lemma SSR_mult_zero_right : (n:A) n*0 == 0. -Intro; Rewrite (mult_sym n Azero); Auto. -Save. - -Lemma SSR_mult_zero_right2 : (n:A) 0 == n*0. -Intro; Rewrite (mult_sym n Azero); Auto. -Save. - -Lemma SSR_plus_zero_right :(n:A) n + 0 == n. -Intro; Rewrite (plus_sym n Azero); Auto. -Save. - -Lemma SSR_plus_zero_right2 :(n:A) n == n + 0. -Intro; Rewrite (plus_sym n Azero); Auto. -Save. - -Lemma SSR_mult_one_right : (n:A) n*1 == n. -Intro; Rewrite (mult_sym n Aone); Auto. -Save. - -Lemma SSR_mult_one_right2 : (n:A) n == n*1. -Intro; Rewrite (mult_sym n Aone); Auto. -Save. - -Lemma SSR_plus_reg_right : (n,m,p:A) m+n == p+n -> m==p. -Intros n m p; Rewrite (plus_sym m n); Rewrite (plus_sym p n). -Intro; Apply plus_reg_left with n; Trivial. -Save. +Lemma SSR_mult_assoc2 : forall n m p:A, n * m * p == n * (m * p). +auto. Qed. + +Lemma SSR_plus_assoc2 : forall n m p:A, n + m + p == n + (m + p). +auto. Qed. + +Lemma SSR_plus_zero_left2 : forall n:A, n == 0 + n. +auto. Qed. + +Lemma SSR_mult_one_left2 : forall n:A, n == 1 * n. +auto. Qed. + +Lemma SSR_mult_zero_left2 : forall n:A, 0 == 0 * n. +auto. Qed. + +Lemma SSR_distr_left2 : forall n m p:A, n * p + m * p == (n + m) * p. +auto. Qed. + +Lemma SSR_plus_permute : forall n m p:A, n + (m + p) == m + (n + p). +intros. +rewrite (plus_assoc n m p). +rewrite (plus_comm n m). +rewrite <- (plus_assoc m n p). +trivial. +Qed. + +Lemma SSR_mult_permute : forall n m p:A, n * (m * p) == m * (n * p). +intros. +rewrite (mult_assoc n m p). +rewrite (mult_comm n m). +rewrite <- (mult_assoc m n p). +trivial. +Qed. + +Hint Resolve SSR_plus_permute SSR_mult_permute. + +Lemma SSR_distr_right : forall n m p:A, n * (m + p) == n * m + n * p. +intros. +rewrite (mult_comm n (m + p)). +rewrite (mult_comm n m). +rewrite (mult_comm n p). +auto. +Qed. + +Lemma SSR_distr_right2 : forall n m p:A, n * m + n * p == n * (m + p). +intros. +apply equiv_sym. +apply SSR_distr_right. +Qed. + +Lemma SSR_mult_zero_right : forall n:A, n * 0 == 0. +intro; rewrite (mult_comm n 0); auto. +Qed. + +Lemma SSR_mult_zero_right2 : forall n:A, 0 == n * 0. +intro; rewrite (mult_comm n 0); auto. +Qed. + +Lemma SSR_plus_zero_right : forall n:A, n + 0 == n. +intro; rewrite (plus_comm n 0); auto. +Qed. + +Lemma SSR_plus_zero_right2 : forall n:A, n == n + 0. +intro; rewrite (plus_comm n 0); auto. +Qed. + +Lemma SSR_mult_one_right : forall n:A, n * 1 == n. +intro; rewrite (mult_comm n 1); auto. +Qed. + +Lemma SSR_mult_one_right2 : forall n:A, n == n * 1. +intro; rewrite (mult_comm n 1); auto. +Qed. + +Lemma SSR_plus_reg_right : forall n m p:A, m + n == p + n -> m == p. +intros n m p; rewrite (plus_comm m n); rewrite (plus_comm p n). +intro; apply plus_reg_left with n; trivial. +Qed. End Theory_of_semi_setoid_rings. Section Theory_of_setoid_rings. -Record Setoid_Ring_Theory : Prop := -{ STh_plus_sym : (n,m:A) n + m == m + n; - STh_plus_assoc : (n,m,p:A) n + (m + p) == (n + m) + p; - STh_mult_sym : (n,m:A) n*m == m*n; - STh_mult_assoc : (n,m,p:A) n*(m*p) == (n*m)*p; - STh_plus_zero_left :(n:A) 0 + n == n; - STh_mult_one_left : (n:A) 1*n == n; - STh_opp_def : (n:A) n + (-n) == 0; - STh_distr_left : (n,m,p:A) (n + m)*p == n*p + m*p; - STh_eq_prop : (x,y:A) (Is_true (Aeq x y)) -> x == y -}. +Record Setoid_Ring_Theory : Prop := + {STh_plus_comm : forall n m:A, n + m == m + n; + STh_plus_assoc : forall n m p:A, n + (m + p) == n + m + p; + STh_mult_sym : forall n m:A, n * m == m * n; + STh_mult_assoc : forall n m p:A, n * (m * p) == n * m * p; + STh_plus_zero_left : forall n:A, 0 + n == n; + STh_mult_one_left : forall n:A, 1 * n == n; + STh_opp_def : forall n:A, n + - n == 0; + STh_distr_left : forall n m p:A, (n + m) * p == n * p + m * p; + STh_eq_prop : forall x y:A, Is_true (Aeq x y) -> x == y}. Variable T : Setoid_Ring_Theory. -Local plus_sym := (STh_plus_sym T). -Local plus_assoc := (STh_plus_assoc T). -Local mult_sym := (STh_mult_sym T). -Local mult_assoc := (STh_mult_assoc T). -Local plus_zero_left := (STh_plus_zero_left T). -Local mult_one_left := (STh_mult_one_left T). -Local opp_def := (STh_opp_def T). -Local distr_left := (STh_distr_left T). -Local equiv_refl := (Seq_refl A Aequiv S). -Local equiv_sym := (Seq_sym A Aequiv S). -Local equiv_trans := (Seq_trans A Aequiv S). - -Hints Resolve plus_sym plus_assoc mult_sym mult_assoc - plus_zero_left mult_one_left opp_def distr_left - equiv_refl equiv_sym. +Let plus_comm := STh_plus_comm T. +Let plus_assoc := STh_plus_assoc T. +Let mult_comm := STh_mult_sym T. +Let mult_assoc := STh_mult_assoc T. +Let plus_zero_left := STh_plus_zero_left T. +Let mult_one_left := STh_mult_one_left T. +Let opp_def := STh_opp_def T. +Let distr_left := STh_distr_left T. +Let equiv_refl := Seq_refl A Aequiv S. +Let equiv_sym := Seq_sym A Aequiv S. +Let equiv_trans := Seq_trans A Aequiv S. + +Hint Resolve plus_comm plus_assoc mult_comm mult_assoc plus_zero_left + mult_one_left opp_def distr_left equiv_refl equiv_sym. (* Lemmas whose form is x=y are also provided in form y=x because Auto does not symmetry *) -Lemma STh_mult_assoc2 : (n,m,p:A) (n * m) * p == n * (m * p). -Auto. Save. - -Lemma STh_plus_assoc2 : (n,m,p:A) (n + m) + p == n + (m + p). -Auto. Save. - -Lemma STh_plus_zero_left2 : (n:A) n == 0 + n. -Auto. Save. - -Lemma STh_mult_one_left2 : (n:A) n == 1*n. -Auto. Save. - -Lemma STh_distr_left2 : (n,m,p:A) n*p + m*p == (n + m)*p. -Auto. Save. - -Lemma STh_opp_def2 : (n:A) 0 == n + (-n). -Auto. Save. - -Lemma STh_plus_permute : (n,m,p:A) n + (m + p) == m + (n + p). -Intros. -Rewrite (plus_assoc n m p). -Rewrite (plus_sym n m). -Rewrite <- (plus_assoc m n p). -Trivial. -Save. - -Lemma STh_mult_permute : (n,m,p:A) n*(m*p) == m*(n*p). -Intros. -Rewrite (mult_assoc n m p). -Rewrite (mult_sym n m). -Rewrite <- (mult_assoc m n p). -Trivial. -Save. - -Hints Resolve STh_plus_permute STh_mult_permute. - -Lemma Saux1 : (a:A) a + a == a -> a == 0. -Intros. -Rewrite <- (plus_zero_left a). -Rewrite (plus_sym Azero a). -Setoid_replace (Aplus a Azero) with (Aplus a (Aplus a (Aopp a))); Auto. -Rewrite (plus_assoc a a (Aopp a)). -Rewrite H. -Apply opp_def. -Save. - -Lemma STh_mult_zero_left :(n:A) 0*n == 0. -Intros. -Apply Saux1. -Rewrite <- (distr_left Azero Azero n). -Rewrite (plus_zero_left Azero). -Trivial. -Save. -Hints Resolve STh_mult_zero_left. - -Lemma STh_mult_zero_left2 : (n:A) 0 == 0*n. -Auto. -Save. - -Lemma Saux2 : (x,y,z:A) x+y==0 -> x+z==0 -> y == z. -Intros. -Rewrite <- (plus_zero_left y). -Rewrite <- H0. -Rewrite <- (plus_assoc x z y). -Rewrite (plus_sym z y). -Rewrite (plus_assoc x y z). -Rewrite H. -Auto. -Save. - -Lemma STh_opp_mult_left : (x,y:A) -(x*y) == (-x)*y. -Intros. -Apply Saux2 with (Amult x y); Auto. -Rewrite <- (distr_left x (Aopp x) y). -Rewrite (opp_def x). -Auto. -Save. -Hints Resolve STh_opp_mult_left. - -Lemma STh_opp_mult_left2 : (x,y:A) (-x)*y == -(x*y) . -Auto. -Save. - -Lemma STh_mult_zero_right : (n:A) n*0 == 0. -Intro; Rewrite (mult_sym n Azero); Auto. -Save. - -Lemma STh_mult_zero_right2 : (n:A) 0 == n*0. -Intro; Rewrite (mult_sym n Azero); Auto. -Save. - -Lemma STh_plus_zero_right :(n:A) n + 0 == n. -Intro; Rewrite (plus_sym n Azero); Auto. -Save. - -Lemma STh_plus_zero_right2 :(n:A) n == n + 0. -Intro; Rewrite (plus_sym n Azero); Auto. -Save. - -Lemma STh_mult_one_right : (n:A) n*1 == n. -Intro; Rewrite (mult_sym n Aone); Auto. -Save. - -Lemma STh_mult_one_right2 : (n:A) n == n*1. -Intro; Rewrite (mult_sym n Aone); Auto. -Save. - -Lemma STh_opp_mult_right : (x,y:A) -(x*y) == x*(-y). -Intros. -Rewrite (mult_sym x y). -Rewrite (mult_sym x (Aopp y)). -Auto. -Save. - -Lemma STh_opp_mult_right2 : (x,y:A) x*(-y) == -(x*y). -Intros. -Rewrite (mult_sym x y). -Rewrite (mult_sym x (Aopp y)). -Auto. -Save. - -Lemma STh_plus_opp_opp : (x,y:A) (-x) + (-y) == -(x+y). -Intros. -Apply Saux2 with (Aplus x y); Auto. -Rewrite (STh_plus_permute (Aplus x y) (Aopp x) (Aopp y)). -Rewrite <- (plus_assoc x y (Aopp y)). -Rewrite (opp_def y); Rewrite (STh_plus_zero_right x). -Rewrite (STh_opp_def2 x); Trivial. -Save. - -Lemma STh_plus_permute_opp: (n,m,p:A) (-m)+(n+p) == n+((-m)+p). -Auto. -Save. - -Lemma STh_opp_opp : (n:A) -(-n) == n. -Intro. -Apply Saux2 with (Aopp n); Auto. -Rewrite (plus_sym (Aopp n) n); Auto. -Save. -Hints Resolve STh_opp_opp. - -Lemma STh_opp_opp2 : (n:A) n == -(-n). -Auto. -Save. - -Lemma STh_mult_opp_opp : (x,y:A) (-x)*(-y) == x*y. -Intros. -Rewrite (STh_opp_mult_left2 x (Aopp y)). -Rewrite (STh_opp_mult_right2 x y). -Trivial. -Save. - -Lemma STh_mult_opp_opp2 : (x,y:A) x*y == (-x)*(-y). -Intros. -Apply equiv_sym. -Apply STh_mult_opp_opp. -Save. - -Lemma STh_opp_zero : -0 == 0. -Rewrite <- (plus_zero_left (Aopp Azero)). -Trivial. -Save. - -Lemma STh_plus_reg_left : (n,m,p:A) n+m == n+p -> m==p. -Intros. -Rewrite <- (plus_zero_left m). -Rewrite <- (plus_zero_left p). -Rewrite <- (opp_def n). -Rewrite (plus_sym n (Aopp n)). -Rewrite <- (plus_assoc (Aopp n) n m). -Rewrite <- (plus_assoc (Aopp n) n p). -Auto. -Save. - -Lemma STh_plus_reg_right : (n,m,p:A) m+n == p+n -> m==p. -Intros. -Apply STh_plus_reg_left with n. -Rewrite (plus_sym n m); Rewrite (plus_sym n p); -Assumption. -Save. - -Lemma STh_distr_right : (n,m,p:A) n*(m+p) == (n*m)+(n*p). -Intros. -Rewrite (mult_sym n (Aplus m p)). -Rewrite (mult_sym n m). -Rewrite (mult_sym n p). -Trivial. -Save. - -Lemma STh_distr_right2 : (n,m,p:A) (n*m)+(n*p) == n*(m+p). -Intros. -Apply equiv_sym. -Apply STh_distr_right. -Save. +Lemma STh_mult_assoc2 : forall n m p:A, n * m * p == n * (m * p). +auto. Qed. + +Lemma STh_plus_assoc2 : forall n m p:A, n + m + p == n + (m + p). +auto. Qed. + +Lemma STh_plus_zero_left2 : forall n:A, n == 0 + n. +auto. Qed. + +Lemma STh_mult_one_left2 : forall n:A, n == 1 * n. +auto. Qed. + +Lemma STh_distr_left2 : forall n m p:A, n * p + m * p == (n + m) * p. +auto. Qed. + +Lemma STh_opp_def2 : forall n:A, 0 == n + - n. +auto. Qed. + +Lemma STh_plus_permute : forall n m p:A, n + (m + p) == m + (n + p). +intros. +rewrite (plus_assoc n m p). +rewrite (plus_comm n m). +rewrite <- (plus_assoc m n p). +trivial. +Qed. + +Lemma STh_mult_permute : forall n m p:A, n * (m * p) == m * (n * p). +intros. +rewrite (mult_assoc n m p). +rewrite (mult_comm n m). +rewrite <- (mult_assoc m n p). +trivial. +Qed. + +Hint Resolve STh_plus_permute STh_mult_permute. + +Lemma Saux1 : forall a:A, a + a == a -> a == 0. +intros. +rewrite <- (plus_zero_left a). +rewrite (plus_comm 0 a). +setoid_replace (a + 0) with (a + (a + - a)); auto. +rewrite (plus_assoc a a (- a)). +rewrite H. +apply opp_def. +Qed. + +Lemma STh_mult_zero_left : forall n:A, 0 * n == 0. +intros. +apply Saux1. +rewrite <- (distr_left 0 0 n). +rewrite (plus_zero_left 0). +trivial. +Qed. +Hint Resolve STh_mult_zero_left. + +Lemma STh_mult_zero_left2 : forall n:A, 0 == 0 * n. +auto. +Qed. + +Lemma Saux2 : forall x y z:A, x + y == 0 -> x + z == 0 -> y == z. +intros. +rewrite <- (plus_zero_left y). +rewrite <- H0. +rewrite <- (plus_assoc x z y). +rewrite (plus_comm z y). +rewrite (plus_assoc x y z). +rewrite H. +auto. +Qed. + +Lemma STh_opp_mult_left : forall x y:A, - (x * y) == - x * y. +intros. +apply Saux2 with (x * y); auto. +rewrite <- (distr_left x (- x) y). +rewrite (opp_def x). +auto. +Qed. +Hint Resolve STh_opp_mult_left. + +Lemma STh_opp_mult_left2 : forall x y:A, - x * y == - (x * y). +auto. +Qed. + +Lemma STh_mult_zero_right : forall n:A, n * 0 == 0. +intro; rewrite (mult_comm n 0); auto. +Qed. + +Lemma STh_mult_zero_right2 : forall n:A, 0 == n * 0. +intro; rewrite (mult_comm n 0); auto. +Qed. + +Lemma STh_plus_zero_right : forall n:A, n + 0 == n. +intro; rewrite (plus_comm n 0); auto. +Qed. + +Lemma STh_plus_zero_right2 : forall n:A, n == n + 0. +intro; rewrite (plus_comm n 0); auto. +Qed. + +Lemma STh_mult_one_right : forall n:A, n * 1 == n. +intro; rewrite (mult_comm n 1); auto. +Qed. + +Lemma STh_mult_one_right2 : forall n:A, n == n * 1. +intro; rewrite (mult_comm n 1); auto. +Qed. + +Lemma STh_opp_mult_right : forall x y:A, - (x * y) == x * - y. +intros. +rewrite (mult_comm x y). +rewrite (mult_comm x (- y)). +auto. +Qed. + +Lemma STh_opp_mult_right2 : forall x y:A, x * - y == - (x * y). +intros. +rewrite (mult_comm x y). +rewrite (mult_comm x (- y)). +auto. +Qed. + +Lemma STh_plus_opp_opp : forall x y:A, - x + - y == - (x + y). +intros. +apply Saux2 with (x + y); auto. +rewrite (STh_plus_permute (x + y) (- x) (- y)). +rewrite <- (plus_assoc x y (- y)). +rewrite (opp_def y); rewrite (STh_plus_zero_right x). +rewrite (STh_opp_def2 x); trivial. +Qed. + +Lemma STh_plus_permute_opp : forall n m p:A, - m + (n + p) == n + (- m + p). +auto. +Qed. + +Lemma STh_opp_opp : forall n:A, - - n == n. +intro. +apply Saux2 with (- n); auto. +rewrite (plus_comm (- n) n); auto. +Qed. +Hint Resolve STh_opp_opp. + +Lemma STh_opp_opp2 : forall n:A, n == - - n. +auto. +Qed. + +Lemma STh_mult_opp_opp : forall x y:A, - x * - y == x * y. +intros. +rewrite (STh_opp_mult_left2 x (- y)). +rewrite (STh_opp_mult_right2 x y). +trivial. +Qed. + +Lemma STh_mult_opp_opp2 : forall x y:A, x * y == - x * - y. +intros. +apply equiv_sym. +apply STh_mult_opp_opp. +Qed. + +Lemma STh_opp_zero : - 0 == 0. +rewrite <- (plus_zero_left (- 0)). +trivial. +Qed. + +Lemma STh_plus_reg_left : forall n m p:A, n + m == n + p -> m == p. +intros. +rewrite <- (plus_zero_left m). +rewrite <- (plus_zero_left p). +rewrite <- (opp_def n). +rewrite (plus_comm n (- n)). +rewrite <- (plus_assoc (- n) n m). +rewrite <- (plus_assoc (- n) n p). +auto. +Qed. + +Lemma STh_plus_reg_right : forall n m p:A, m + n == p + n -> m == p. +intros. +apply STh_plus_reg_left with n. +rewrite (plus_comm n m); rewrite (plus_comm n p); assumption. +Qed. + +Lemma STh_distr_right : forall n m p:A, n * (m + p) == n * m + n * p. +intros. +rewrite (mult_comm n (m + p)). +rewrite (mult_comm n m). +rewrite (mult_comm n p). +trivial. +Qed. + +Lemma STh_distr_right2 : forall n m p:A, n * m + n * p == n * (m + p). +intros. +apply equiv_sym. +apply STh_distr_right. +Qed. End Theory_of_setoid_rings. -Hints Resolve STh_mult_zero_left STh_plus_reg_left : core. +Hint Resolve STh_mult_zero_left STh_plus_reg_left: core. Unset Implicit Arguments. Definition Semi_Setoid_Ring_Theory_of : Setoid_Ring_Theory -> Semi_Setoid_Ring_Theory. -Intros until 1; Case H. -Split; Intros; Simpl; EAuto. +intros until 1; case H. +split; intros; simpl in |- *; eauto. Defined. -Coercion Semi_Setoid_Ring_Theory_of : - Setoid_Ring_Theory >-> Semi_Setoid_Ring_Theory. +Coercion Semi_Setoid_Ring_Theory_of : Setoid_Ring_Theory >-> + Semi_Setoid_Ring_Theory. @@ -426,4 +424,4 @@ Section power_ring. End power_ring. -End Setoid_rings. +End Setoid_rings.
\ No newline at end of file diff --git a/contrib/ring/ZArithRing.v b/contrib/ring/ZArithRing.v index cf5e18c5e..e6a7bf2af 100644 --- a/contrib/ring/ZArithRing.v +++ b/contrib/ring/ZArithRing.v @@ -12,24 +12,25 @@ Require Export ArithRing. Require Export ZArith_base. -Require Eqdep_dec. +Require Import Eqdep_dec. -Definition Zeq := [x,y:Z] - Cases `x ?= y ` of - EGAL => true +Definition Zeq (x y:Z) := + match (x ?= y)%Z with + | Datatypes.Eq => true | _ => false end. -Lemma Zeq_prop : (x,y:Z)(Is_true (Zeq x y)) -> x==y. - Intros x y H; Unfold Zeq in H. - Apply Zcompare_EGAL_eq. - NewDestruct (Zcompare x y); [Reflexivity | Contradiction | Contradiction ]. -Save. +Lemma Zeq_prop : forall x y:Z, Is_true (Zeq x y) -> x = y. + intros x y H; unfold Zeq in H. + apply Zcompare_Eq_eq. + destruct (x ?= y)%Z; [ reflexivity | contradiction | contradiction ]. +Qed. -Definition ZTheory : (Ring_Theory Zplus Zmult `1` `0` Zopp Zeq). - Split; Intros; Apply eq2eqT; EAuto with zarith. - Apply eqT2eq; Apply Zeq_prop; Assumption. -Save. +Definition ZTheory : Ring_Theory Zplus Zmult 1%Z 0%Z Zopp Zeq. + split; intros; apply eq2eqT; eauto with zarith. + apply eqT2eq; apply Zeq_prop; assumption. +Qed. (* NatConstants and NatTheory are defined in Ring_theory.v *) -Add Ring Z Zplus Zmult `1` `0` Zopp Zeq ZTheory [POS NEG ZERO xO xI xH]. +Add Ring Z Zplus Zmult 1%Z 0%Z Zopp Zeq ZTheory + [ Zpos Zneg 0%Z xO xI 1%positive ].
\ No newline at end of file diff --git a/contrib/romega/ROmega.v b/contrib/romega/ROmega.v index ba02b232e..f1ffcf13d 100644 --- a/contrib/romega/ROmega.v +++ b/contrib/romega/ROmega.v @@ -6,5 +6,5 @@ *************************************************************************) -Require Omega. -Require ReflOmegaCore. +Require Import Omega. +Require Import ReflOmegaCore.
\ No newline at end of file diff --git a/contrib/romega/ReflOmegaCore.v b/contrib/romega/ReflOmegaCore.v index fa49badbf..b69f40df8 100644 --- a/contrib/romega/ReflOmegaCore.v +++ b/contrib/romega/ReflOmegaCore.v @@ -6,11 +6,11 @@ *************************************************************************) -Require Arith. -Require PolyList. -Require Bool. -Require ZArith_base. -Require OmegaLemmas. +Require Import Arith. +Require Import List. +Require Import Bool. +Require Import ZArith_base. +Require Import OmegaLemmas. (* \subsection{Définition des types} *) @@ -22,13 +22,12 @@ Require OmegaLemmas. des termes. *) Inductive term : Set := - Tint : Z -> term - | Tplus : term -> term -> term - | Tmult : term -> term -> term - | Tminus : term -> term -> term - | Topp : term -> term - | Tvar : nat -> term -. + | Tint : Z -> term + | Tplus : term -> term -> term + | Tmult : term -> term -> term + | Tminus : term -> term -> term + | Topp : term -> term + | Tvar : nat -> term. (* \subsubsection{Définition des buts réifiés} *) (* Définition très restreinte des prédicats manipulés (à enrichir). @@ -40,26 +39,28 @@ Inductive term : Set := génération d'une liste de but et donc l'application d'une liste de tactiques de résolution ([execute_omega]) *) Inductive proposition : Set := - EqTerm : term -> term -> proposition -| LeqTerm : term -> term -> proposition -| TrueTerm : proposition -| FalseTerm : proposition -| Tnot : proposition -> proposition -| GeqTerm : term -> term -> proposition -| GtTerm : term -> term -> proposition -| LtTerm : term -> term -> proposition -| NeqTerm: term -> term -> proposition. + | EqTerm : term -> term -> proposition + | LeqTerm : term -> term -> proposition + | TrueTerm : proposition + | FalseTerm : proposition + | Tnot : proposition -> proposition + | GeqTerm : term -> term -> proposition + | GtTerm : term -> term -> proposition + | LtTerm : term -> term -> proposition + | NeqTerm : term -> term -> proposition. (* Définition des hypothèses *) Notation hyps := (list proposition). -Definition absurd := (cons FalseTerm (nil proposition)). +Definition absurd := FalseTerm :: nil. (* \subsubsection{Traces de fusion d'équations} *) Inductive t_fusion : Set := - F_equal : t_fusion | F_cancel : t_fusion - | F_left : t_fusion | F_right : t_fusion. + | F_equal : t_fusion + | F_cancel : t_fusion + | F_left : t_fusion + | F_right : t_fusion. (* \subsection{Egalité décidable efficace} *) (* Pour chaque type de donnée réifié, on calcule un test d'égalité efficace. @@ -74,176 +75,223 @@ Inductive t_fusion : Set := (* Ces deux tactiques permettent de résoudre pas mal de cas. L'une pour les théorèmes positifs, l'autre pour les théorèmes négatifs *) -Tactic Definition absurd_case := Simpl; Intros; Discriminate. -Tactic Definition trivial_case := Unfold not; Intros; Discriminate. +Ltac absurd_case := simpl in |- *; intros; discriminate. +Ltac trivial_case := unfold not in |- *; intros; discriminate. (* \subsubsection{Entiers naturels} *) -Fixpoint eq_nat [t1,t2: nat] : bool := - Cases t1 of - O => Cases t2 of O => true | _ => false end - | (S n1)=> Cases t2 of O => false | (S n2) => (eq_nat n1 n2) end +Fixpoint eq_nat (t1 t2:nat) {struct t2} : bool := + match t1 with + | O => match t2 with + | O => true + | _ => false + end + | S n1 => match t2 with + | O => false + | S n2 => eq_nat n1 n2 + end end. -Theorem eq_nat_true : (t1,t2: nat) (eq_nat t1 t2) = true -> t1 = t2. +Theorem eq_nat_true : forall t1 t2:nat, eq_nat t1 t2 = true -> t1 = t2. -Induction t1; [ - Intro t2; Case t2; [ Trivial | absurd_case ] -| Intros n H t2; Case t2; - [ absurd_case | Simpl; Intros; Rewrite (H n0); [ Trivial | Assumption]]]. +simple induction t1; + [ intro t2; case t2; [ trivial | absurd_case ] + | intros n H t2; case t2; + [ absurd_case + | simpl in |- *; intros; rewrite (H n0); [ trivial | assumption ] ] ]. -Save. +Qed. -Theorem eq_nat_false : (t1,t2: nat) (eq_nat t1 t2) = false -> ~t1 = t2. +Theorem eq_nat_false : forall t1 t2:nat, eq_nat t1 t2 = false -> t1 <> t2. -Induction t1; [ - Intro t2; Case t2; - [ Simpl;Intros; Discriminate | trivial_case ] -| Intros n H t2; Case t2; Simpl; Unfold not; Intros; [ - Discriminate - | Elim (H n0 H0); Simplify_eq H1; Trivial]]. +simple induction t1; + [ intro t2; case t2; [ simpl in |- *; intros; discriminate | trivial_case ] + | intros n H t2; case t2; simpl in |- *; unfold not in |- *; intros; + [ discriminate | elim (H n0 H0); simplify_eq H1; trivial ] ]. -Save. +Qed. (* \subsubsection{Entiers positifs} *) -Fixpoint eq_pos [p1,p2 : positive] : bool := - Cases p1 of - (xI n1) => Cases p2 of (xI n2) => (eq_pos n1 n2) | _ => false end - | (xO n1) => Cases p2 of (xO n2) => (eq_pos n1 n2) | _ => false end - | xH => Cases p2 of xH => true | _ => false end +Fixpoint eq_pos (p1 p2:positive) {struct p2} : bool := + match p1 with + | xI n1 => match p2 with + | xI n2 => eq_pos n1 n2 + | _ => false + end + | xO n1 => match p2 with + | xO n2 => eq_pos n1 n2 + | _ => false + end + | xH => match p2 with + | xH => true + | _ => false + end end. -Theorem eq_pos_true : (t1,t2: positive) (eq_pos t1 t2) = true -> t1 = t2. +Theorem eq_pos_true : forall t1 t2:positive, eq_pos t1 t2 = true -> t1 = t2. -Induction t1; [ - Intros p H t2; Case t2; [ - Simpl; Intros; Rewrite (H p0 H0); Trivial | absurd_case | absurd_case ] -| Intros p H t2; Case t2; [ - absurd_case | Simpl; Intros; Rewrite (H p0 H0); Trivial | absurd_case ] -| Intro t2; Case t2; [ absurd_case | absurd_case | Auto ]]. +simple induction t1; + [ intros p H t2; case t2; + [ simpl in |- *; intros; rewrite (H p0 H0); trivial + | absurd_case + | absurd_case ] + | intros p H t2; case t2; + [ absurd_case + | simpl in |- *; intros; rewrite (H p0 H0); trivial + | absurd_case ] + | intro t2; case t2; [ absurd_case | absurd_case | auto ] ]. -Save. +Qed. -Theorem eq_pos_false : (t1,t2: positive) (eq_pos t1 t2) = false -> ~t1 = t2. - -Induction t1; [ - Intros p H t2; Case t2; [ - Simpl; Unfold not; Intros; Elim (H p0 H0); Simplify_eq H1; Auto - | trivial_case | trivial_case ] -| Intros p H t2; Case t2; [ - trivial_case - | Simpl; Unfold not; Intros; Elim (H p0 H0); Simplify_eq H1; Auto - | trivial_case ] -| Intros t2; Case t2; [ trivial_case | trivial_case | absurd_case ]]. -Save. +Theorem eq_pos_false : + forall t1 t2:positive, eq_pos t1 t2 = false -> t1 <> t2. + +simple induction t1; + [ intros p H t2; case t2; + [ simpl in |- *; unfold not in |- *; intros; elim (H p0 H0); + simplify_eq H1; auto + | trivial_case + | trivial_case ] + | intros p H t2; case t2; + [ trivial_case + | simpl in |- *; unfold not in |- *; intros; elim (H p0 H0); + simplify_eq H1; auto + | trivial_case ] + | intros t2; case t2; [ trivial_case | trivial_case | absurd_case ] ]. +Qed. (* \subsubsection{Entiers relatifs} *) -Definition eq_Z [z1,z2: Z] : bool := - Cases z1 of - ZERO => Cases z2 of ZERO => true | _ => false end - | (POS p1) => Cases z2 of (POS p2) => (eq_pos p1 p2) | _ => false end - | (NEG p1) => Cases z2 of (NEG p2) => (eq_pos p1 p2) | _ => false end +Definition eq_Z (z1 z2:Z) : bool := + match z1 with + | Z0 => match z2 with + | Z0 => true + | _ => false + end + | Zpos p1 => match z2 with + | Zpos p2 => eq_pos p1 p2 + | _ => false + end + | Zneg p1 => match z2 with + | Zneg p2 => eq_pos p1 p2 + | _ => false + end end. -Theorem eq_Z_true : (t1,t2: Z) (eq_Z t1 t2) = true -> t1 = t2. - -Induction t1; [ - Intros t2; Case t2; [ Auto | absurd_case | absurd_case ] -| Intros p t2; Case t2; [ - absurd_case | Simpl; Intros; Rewrite (eq_pos_true p p0 H); Trivial - | absurd_case ] -| Intros p t2; Case t2; [ - absurd_case | absurd_case - | Simpl; Intros; Rewrite (eq_pos_true p p0 H); Trivial ]]. - -Save. - -Theorem eq_Z_false : (t1,t2: Z) (eq_Z t1 t2) = false -> ~(t1 = t2). - -Induction t1; [ - Intros t2; Case t2; [ absurd_case | trivial_case | trivial_case ] -| Intros p t2; Case t2; [ - absurd_case - | Simpl; Unfold not; Intros; Elim (eq_pos_false p p0 H); Simplify_eq H0; Auto - | trivial_case ] -| Intros p t2; Case t2; [ - absurd_case | trivial_case - | Simpl; Unfold not; Intros; Elim (eq_pos_false p p0 H); - Simplify_eq H0; Auto]]. -Save. +Theorem eq_Z_true : forall t1 t2:Z, eq_Z t1 t2 = true -> t1 = t2. + +simple induction t1; + [ intros t2; case t2; [ auto | absurd_case | absurd_case ] + | intros p t2; case t2; + [ absurd_case + | simpl in |- *; intros; rewrite (eq_pos_true p p0 H); trivial + | absurd_case ] + | intros p t2; case t2; + [ absurd_case + | absurd_case + | simpl in |- *; intros; rewrite (eq_pos_true p p0 H); trivial ] ]. + +Qed. + +Theorem eq_Z_false : forall t1 t2:Z, eq_Z t1 t2 = false -> t1 <> t2. + +simple induction t1; + [ intros t2; case t2; [ absurd_case | trivial_case | trivial_case ] + | intros p t2; case t2; + [ absurd_case + | simpl in |- *; unfold not in |- *; intros; elim (eq_pos_false p p0 H); + simplify_eq H0; auto + | trivial_case ] + | intros p t2; case t2; + [ absurd_case + | trivial_case + | simpl in |- *; unfold not in |- *; intros; elim (eq_pos_false p p0 H); + simplify_eq H0; auto ] ]. +Qed. (* \subsubsection{Termes réifiés} *) -Fixpoint eq_term [t1,t2: term] : bool := - Cases t1 of - (Tint st1) => - Cases t2 of (Tint st2) => (eq_Z st1 st2) | _ => false end - | (Tplus st11 st12) => - Cases t2 of - (Tplus st21 st22) => - (andb (eq_term st11 st21) (eq_term st12 st22)) - | _ => false - end - | (Tmult st11 st12) => - Cases t2 of - (Tmult st21 st22) => - (andb (eq_term st11 st21) (eq_term st12 st22)) - | _ => false - end - | (Tminus st11 st12) => - Cases t2 of - (Tminus st21 st22) => - (andb (eq_term st11 st21) (eq_term st12 st22)) - | _ => false - end - | (Topp st1) => - Cases t2 of (Topp st2) => (eq_term st1 st2) | _ => false end - | (Tvar st1) => - Cases t2 of (Tvar st2) => (eq_nat st1 st2) | _ => false end - end. - -Theorem eq_term_true : (t1,t2: term) (eq_term t1 t2) = true -> t1 = t2. - - -Induction t1; Intros until t2; Case t2; Try absurd_case; Simpl; [ - Intros; Elim eq_Z_true with 1 := H; Trivial -| Intros t21 t22 H3; Elim andb_prop with 1:= H3; Intros H4 H5; - Elim H with 1 := H4; Elim H0 with 1 := H5; Trivial -| Intros t21 t22 H3; Elim andb_prop with 1:= H3; Intros H4 H5; - Elim H with 1 := H4; Elim H0 with 1 := H5; Trivial -| Intros t21 t22 H3; Elim andb_prop with 1:= H3; Intros H4 H5; - Elim H with 1 := H4; Elim H0 with 1 := H5; Trivial -| Intros t21 H3; Elim H with 1 := H3; Trivial -| Intros; Elim eq_nat_true with 1 := H; Trivial ]. - -Save. - -Theorem eq_term_false : (t1,t2: term) (eq_term t1 t2) = false -> ~(t1 = t2). - -Induction t1; [ - Intros z t2; Case t2; Try trivial_case; Simpl; Unfold not; Intros; - Elim eq_Z_false with 1:=H; Simplify_eq H0; Auto -| Intros t11 H1 t12 H2 t2; Case t2; Try trivial_case; Simpl; Intros t21 t22 H3; - Unfold not; Intro H4; Elim andb_false_elim with 1:= H3; Intros H5; - [ Elim H1 with 1 := H5; Simplify_eq H4; Auto | - Elim H2 with 1 := H5; Simplify_eq H4; Auto ] -| Intros t11 H1 t12 H2 t2; Case t2; Try trivial_case; Simpl; Intros t21 t22 H3; - Unfold not; Intro H4; Elim andb_false_elim with 1:= H3; Intros H5; - [ Elim H1 with 1 := H5; Simplify_eq H4; Auto | - Elim H2 with 1 := H5; Simplify_eq H4; Auto ] -| Intros t11 H1 t12 H2 t2; Case t2; Try trivial_case; Simpl; Intros t21 t22 H3; - Unfold not; Intro H4; Elim andb_false_elim with 1:= H3; Intros H5; - [ Elim H1 with 1 := H5; Simplify_eq H4; Auto | - Elim H2 with 1 := H5; Simplify_eq H4; Auto ] -| Intros t11 H1 t2; Case t2; Try trivial_case; Simpl; Intros t21 H3; - Unfold not; Intro H4; Elim H1 with 1 := H3; Simplify_eq H4; Auto -| Intros n t2; Case t2; Try trivial_case; Simpl; Unfold not; Intros; - Elim eq_nat_false with 1:=H; Simplify_eq H0; Auto ]. - -Save. +Fixpoint eq_term (t1 t2:term) {struct t2} : bool := + match t1 with + | Tint st1 => match t2 with + | Tint st2 => eq_Z st1 st2 + | _ => false + end + | Tplus st11 st12 => + match t2 with + | Tplus st21 st22 => andb (eq_term st11 st21) (eq_term st12 st22) + | _ => false + end + | Tmult st11 st12 => + match t2 with + | Tmult st21 st22 => andb (eq_term st11 st21) (eq_term st12 st22) + | _ => false + end + | Tminus st11 st12 => + match t2 with + | Tminus st21 st22 => andb (eq_term st11 st21) (eq_term st12 st22) + | _ => false + end + | Topp st1 => match t2 with + | Topp st2 => eq_term st1 st2 + | _ => false + end + | Tvar st1 => match t2 with + | Tvar st2 => eq_nat st1 st2 + | _ => false + end + end. + +Theorem eq_term_true : forall t1 t2:term, eq_term t1 t2 = true -> t1 = t2. + + +simple induction t1; intros until t2; case t2; try absurd_case; simpl in |- *; + [ intros; elim eq_Z_true with (1 := H); trivial + | intros t21 t22 H3; elim andb_prop with (1 := H3); intros H4 H5; + elim H with (1 := H4); elim H0 with (1 := H5); + trivial + | intros t21 t22 H3; elim andb_prop with (1 := H3); intros H4 H5; + elim H with (1 := H4); elim H0 with (1 := H5); + trivial + | intros t21 t22 H3; elim andb_prop with (1 := H3); intros H4 H5; + elim H with (1 := H4); elim H0 with (1 := H5); + trivial + | intros t21 H3; elim H with (1 := H3); trivial + | intros; elim eq_nat_true with (1 := H); trivial ]. + +Qed. + +Theorem eq_term_false : forall t1 t2:term, eq_term t1 t2 = false -> t1 <> t2. + +simple induction t1; + [ intros z t2; case t2; try trivial_case; simpl in |- *; unfold not in |- *; + intros; elim eq_Z_false with (1 := H); simplify_eq H0; + auto + | intros t11 H1 t12 H2 t2; case t2; try trivial_case; simpl in |- *; + intros t21 t22 H3; unfold not in |- *; intro H4; + elim andb_false_elim with (1 := H3); intros H5; + [ elim H1 with (1 := H5); simplify_eq H4; auto + | elim H2 with (1 := H5); simplify_eq H4; auto ] + | intros t11 H1 t12 H2 t2; case t2; try trivial_case; simpl in |- *; + intros t21 t22 H3; unfold not in |- *; intro H4; + elim andb_false_elim with (1 := H3); intros H5; + [ elim H1 with (1 := H5); simplify_eq H4; auto + | elim H2 with (1 := H5); simplify_eq H4; auto ] + | intros t11 H1 t12 H2 t2; case t2; try trivial_case; simpl in |- *; + intros t21 t22 H3; unfold not in |- *; intro H4; + elim andb_false_elim with (1 := H3); intros H5; + [ elim H1 with (1 := H5); simplify_eq H4; auto + | elim H2 with (1 := H5); simplify_eq H4; auto ] + | intros t11 H1 t2; case t2; try trivial_case; simpl in |- *; intros t21 H3; + unfold not in |- *; intro H4; elim H1 with (1 := H3); + simplify_eq H4; auto + | intros n t2; case t2; try trivial_case; simpl in |- *; unfold not in |- *; + intros; elim eq_nat_false with (1 := H); simplify_eq H0; + auto ]. + +Qed. (* \subsubsection{Tactiques pour éliminer ces tests} @@ -259,74 +307,72 @@ Save. (* Le théorème suivant permet de garder dans les hypothèses la valeur du booléen lors de l'élimination. *) -Theorem bool_ind2 : - (P:(bool->Prop)) (b:bool) - (b = true -> (P true))-> - (b = false -> (P false)) -> (P b). +Theorem bool_ind2 : + forall (P:bool -> Prop) (b:bool), + (b = true -> P true) -> (b = false -> P false) -> P b. -Induction b; Auto. -Save. +simple induction b; auto. +Qed. (* Les tactiques définies si après se comportent exactement comme si on avait utilisé le test précédent et fait une elimination dessus. *) -Tactic Definition Elim_eq_term t1 t2 := - Pattern (eq_term t1 t2); Apply bool_ind2; Intro Aux; [ - Generalize (eq_term_true t1 t2 Aux); Clear Aux - | Generalize (eq_term_false t1 t2 Aux); Clear Aux ]. +Ltac elim_eq_term t1 t2 := + pattern (eq_term t1 t2) in |- *; apply bool_ind2; intro Aux; + [ generalize (eq_term_true t1 t2 Aux); clear Aux + | generalize (eq_term_false t1 t2 Aux); clear Aux ]. -Tactic Definition Elim_eq_Z t1 t2 := - Pattern (eq_Z t1 t2); Apply bool_ind2; Intro Aux; [ - Generalize (eq_Z_true t1 t2 Aux); Clear Aux - | Generalize (eq_Z_false t1 t2 Aux); Clear Aux ]. +Ltac elim_eq_Z t1 t2 := + pattern (eq_Z t1 t2) in |- *; apply bool_ind2; intro Aux; + [ generalize (eq_Z_true t1 t2 Aux); clear Aux + | generalize (eq_Z_false t1 t2 Aux); clear Aux ]. -Tactic Definition Elim_eq_pos t1 t2 := - Pattern (eq_pos t1 t2); Apply bool_ind2; Intro Aux; [ - Generalize (eq_pos_true t1 t2 Aux); Clear Aux - | Generalize (eq_pos_false t1 t2 Aux); Clear Aux ]. +Ltac elim_eq_pos t1 t2 := + pattern (eq_pos t1 t2) in |- *; apply bool_ind2; intro Aux; + [ generalize (eq_pos_true t1 t2 Aux); clear Aux + | generalize (eq_pos_false t1 t2 Aux); clear Aux ]. (* \subsubsection{Comparaison sur Z} *) (* Sujet très lié au précédent : on introduit la tactique d'élimination avec son théorème *) -Theorem relation_ind2 : - (P:(relation->Prop)) (b:relation) - (b = EGAL -> (P EGAL))-> - (b = INFERIEUR -> (P INFERIEUR))-> - (b = SUPERIEUR -> (P SUPERIEUR)) -> (P b). +Theorem relation_ind2 : + forall (P:Datatypes.comparison -> Prop) (b:Datatypes.comparison), + (b = Datatypes.Eq -> P Datatypes.Eq) -> + (b = Datatypes.Lt -> P Datatypes.Lt) -> + (b = Datatypes.Gt -> P Datatypes.Gt) -> P b. -Induction b; Auto. -Save. +simple induction b; auto. +Qed. -Tactic Definition Elim_Zcompare t1 t2 := - Pattern (Zcompare t1 t2); Apply relation_ind2. +Ltac elim_Zcompare t1 t2 := pattern (t1 ?= t2)%Z in |- *; apply relation_ind2. (* \subsection{Interprétations} \subsubsection{Interprétation des termes dans Z} *) -Fixpoint interp_term [env:(list Z); t:term] : Z := - Cases t of - (Tint x) => x - | (Tplus t1 t2) => (Zplus (interp_term env t1) (interp_term env t2)) - | (Tmult t1 t2) => (Zmult (interp_term env t1) (interp_term env t2)) - | (Tminus t1 t2) => (Zminus (interp_term env t1) (interp_term env t2)) - | (Topp t) => (Zopp (interp_term env t)) - | (Tvar n) => (nth n env ZERO) +Fixpoint interp_term (env:list Z) (t:term) {struct t} : Z := + match t with + | Tint x => x + | Tplus t1 t2 => (interp_term env t1 + interp_term env t2)%Z + | Tmult t1 t2 => (interp_term env t1 * interp_term env t2)%Z + | Tminus t1 t2 => (interp_term env t1 - interp_term env t2)%Z + | Topp t => (- interp_term env t)%Z + | Tvar n => nth n env 0%Z end. (* \subsubsection{Interprétation des prédicats} *) -Fixpoint interp_proposition [env: (list Z); p:proposition] : Prop := - Cases p of - (EqTerm t1 t2) => ((interp_term env t1) = (interp_term env t2)) - | (LeqTerm t1 t2) => `(interp_term env t1) <= (interp_term env t2)` +Fixpoint interp_proposition (env:list Z) (p:proposition) {struct p} : Prop := + match p with + | EqTerm t1 t2 => interp_term env t1 = interp_term env t2 + | LeqTerm t1 t2 => (interp_term env t1 <= interp_term env t2)%Z | TrueTerm => True | FalseTerm => False - | (Tnot p') => ~(interp_proposition env p') - | (GeqTerm t1 t2) => `(interp_term env t1) >= (interp_term env t2)` - | (GtTerm t1 t2) => `(interp_term env t1) > (interp_term env t2)` - | (LtTerm t1 t2) => `(interp_term env t1) < (interp_term env t2)` - | (NeqTerm t1 t2) => `(Zne (interp_term env t1) (interp_term env t2))` + | Tnot p' => ~ interp_proposition env p' + | GeqTerm t1 t2 => (interp_term env t1 >= interp_term env t2)%Z + | GtTerm t1 t2 => (interp_term env t1 > interp_term env t2)%Z + | LtTerm t1 t2 => (interp_term env t1 < interp_term env t2)%Z + | NeqTerm t1 t2 => Zne (interp_term env t1) (interp_term env t2) end. (* \subsubsection{Inteprétation des listes d'hypothèses} @@ -334,10 +380,10 @@ Fixpoint interp_proposition [env: (list Z); p:proposition] : Prop := Interprétation sous forme d'une conjonction d'hypothèses plus faciles à manipuler individuellement *) -Fixpoint interp_hyps [env : (list Z); l: hyps] : Prop := - Cases l of - nil => True - | (cons p' l') => (interp_proposition env p') /\ (interp_hyps env l') +Fixpoint interp_hyps (env:list Z) (l:hyps) {struct l} : Prop := + match l with + | nil => True + | p' :: l' => interp_proposition env p' /\ interp_hyps env l' end. (* \paragraph{Sous forme de but} @@ -345,39 +391,37 @@ Fixpoint interp_hyps [env : (list Z); l: hyps] : Prop := [Generalize] et qu'une conjonction est forcément lourde (répétition des types dans les conjonctions intermédiaires) *) -Fixpoint interp_goal [env : (list Z); l: hyps] : Prop := - Cases l of - nil => False - | (cons p' l') => (interp_proposition env p') -> (interp_goal env l') +Fixpoint interp_goal (env:list Z) (l:hyps) {struct l} : Prop := + match l with + | nil => False + | p' :: l' => interp_proposition env p' -> interp_goal env l' end. (* Les théorèmes qui suivent assurent la correspondance entre les deux interprétations. *) -Theorem goal_to_hyps : - (env : (list Z); l: hyps) - ((interp_hyps env l) -> False) -> (interp_goal env l). +Theorem goal_to_hyps : + forall (env:list Z) (l:hyps), + (interp_hyps env l -> False) -> interp_goal env l. -Induction l; [ - Simpl; Auto -| Simpl; Intros a l1 H1 H2 H3; Apply H1; Intro H4; Apply H2; Auto ]. -Save. +simple induction l; + [ simpl in |- *; auto + | simpl in |- *; intros a l1 H1 H2 H3; apply H1; intro H4; apply H2; auto ]. +Qed. -Theorem hyps_to_goal : - (env : (list Z); l: hyps) - (interp_goal env l) -> ((interp_hyps env l) -> False). +Theorem hyps_to_goal : + forall (env:list Z) (l:hyps), + interp_goal env l -> interp_hyps env l -> False. -Induction l; Simpl; [ - Auto -| Intros; Apply H; Elim H1; Auto ]. -Save. +simple induction l; simpl in |- *; [ auto | intros; apply H; elim H1; auto ]. +Qed. (* \subsection{Manipulations sur les hypothèses} *) (* \subsubsection{Définitions de base de stabilité pour la réflexion} *) (* Une opération laisse un terme stable si l'égalité est préservée *) -Definition term_stable [f: term -> term] := - (e: (list Z); t:term) (interp_term e t) = (interp_term e (f t)). +Definition term_stable (f:term -> term) := + forall (e:list Z) (t:term), interp_term e t = interp_term e (f t). (* Une opération est valide sur une hypothèse, si l'hypothèse implique le résultat de l'opération. \emph{Attention : cela ne concerne que des @@ -385,155 +429,156 @@ Definition term_stable [f: term -> term] := On définit la validité pour une opération prenant une ou deux propositions en argument (cela suffit pour omega). *) -Definition valid1 [f: proposition -> proposition] := - (e: (list Z)) (p1: proposition) - (interp_proposition e p1) -> (interp_proposition e (f p1)). +Definition valid1 (f:proposition -> proposition) := + forall (e:list Z) (p1:proposition), + interp_proposition e p1 -> interp_proposition e (f p1). -Definition valid2 [f: proposition -> proposition -> proposition] := - (e: (list Z)) (p1,p2: proposition) - (interp_proposition e p1) -> (interp_proposition e p2) -> - (interp_proposition e (f p1 p2)). +Definition valid2 (f:proposition -> proposition -> proposition) := + forall (e:list Z) (p1 p2:proposition), + interp_proposition e p1 -> + interp_proposition e p2 -> interp_proposition e (f p1 p2). (* Dans cette notion de validité, la fonction prend directement une liste de propositions et rend une nouvelle liste de propositions. On reste contravariant *) -Definition valid_hyps [f: hyps -> hyps] := - (e : (list Z)) (lp: hyps) (interp_hyps e lp) -> (interp_hyps e (f lp)). +Definition valid_hyps (f:hyps -> hyps) := + forall (e:list Z) (lp:hyps), interp_hyps e lp -> interp_hyps e (f lp). (* Enfin ce théorème élimine la contravariance et nous ramène à une opération sur les buts *) Theorem valid_goal : - (env : (list Z); l: hyps; a : hyps -> hyps) - (valid_hyps a) -> (interp_goal env (a l)) -> (interp_goal env l). + forall (env:list Z) (l:hyps) (a:hyps -> hyps), + valid_hyps a -> interp_goal env (a l) -> interp_goal env l. -Intros; Apply goal_to_hyps; Intro H1; Apply (hyps_to_goal env (a l) H0); -Apply H; Assumption. -Save. +intros; apply goal_to_hyps; intro H1; apply (hyps_to_goal env (a l) H0); + apply H; assumption. +Qed. (* \subsubsection{Généralisation à des listes de buts (disjonctions)} *) Notation lhyps := (list hyps). -Fixpoint interp_list_hyps [env: (list Z); l : lhyps] : Prop := - Cases l of - nil => False - | (cons h l') => (interp_hyps env h) \/ (interp_list_hyps env l') - end. - -Fixpoint interp_list_goal [env: (list Z);l : lhyps] : Prop := - Cases l of - nil => True - | (cons h l') => (interp_goal env h) /\ (interp_list_goal env l') - end. - -Theorem list_goal_to_hyps : - (env: (list Z); l: lhyps) - ((interp_list_hyps env l) -> False) -> (interp_list_goal env l). - -Induction l; Simpl; [ - Auto -| Intros h1 l1 H H1; Split; [ - Apply goal_to_hyps; Intro H2; Apply H1; Auto - | Apply H; Intro H2; Apply H1; Auto ]]. -Save. - -Theorem list_hyps_to_goal : - (env: (list Z); l: lhyps) - (interp_list_goal env l) -> ((interp_list_hyps env l) -> False). - -Induction l; Simpl; [ - Auto -| Intros h1 l1 H (H1,H2) H3; Elim H3; Intro H4; [ - Apply hyps_to_goal with 1 := H1; Assumption - | Auto ]]. -Save. - -Definition valid_list_hyps [f: hyps -> lhyps] := - (e : (list Z)) (lp: hyps) (interp_hyps e lp) -> (interp_list_hyps e (f lp)). - -Definition valid_list_goal [f: hyps -> lhyps] := - (e : (list Z)) (lp: hyps) - (interp_list_goal e (f lp)) -> (interp_goal e lp) . - -Theorem goal_valid : - (f: hyps -> lhyps) (valid_list_hyps f) -> (valid_list_goal f). - -Unfold valid_list_goal; Intros f H e lp H1; Apply goal_to_hyps; -Intro H2; Apply list_hyps_to_goal with 1:=H1; Apply (H e lp); Assumption. -Save. +Fixpoint interp_list_hyps (env:list Z) (l:lhyps) {struct l} : Prop := + match l with + | nil => False + | h :: l' => interp_hyps env h \/ interp_list_hyps env l' + end. + +Fixpoint interp_list_goal (env:list Z) (l:lhyps) {struct l} : Prop := + match l with + | nil => True + | h :: l' => interp_goal env h /\ interp_list_goal env l' + end. + +Theorem list_goal_to_hyps : + forall (env:list Z) (l:lhyps), + (interp_list_hyps env l -> False) -> interp_list_goal env l. + +simple induction l; simpl in |- *; + [ auto + | intros h1 l1 H H1; split; + [ apply goal_to_hyps; intro H2; apply H1; auto + | apply H; intro H2; apply H1; auto ] ]. +Qed. + +Theorem list_hyps_to_goal : + forall (env:list Z) (l:lhyps), + interp_list_goal env l -> interp_list_hyps env l -> False. + +simple induction l; simpl in |- *; + [ auto + | intros h1 l1 H [H1 H2] H3; elim H3; intro H4; + [ apply hyps_to_goal with (1 := H1); assumption | auto ] ]. +Qed. + +Definition valid_list_hyps (f:hyps -> lhyps) := + forall (e:list Z) (lp:hyps), interp_hyps e lp -> interp_list_hyps e (f lp). + +Definition valid_list_goal (f:hyps -> lhyps) := + forall (e:list Z) (lp:hyps), interp_list_goal e (f lp) -> interp_goal e lp. + +Theorem goal_valid : + forall f:hyps -> lhyps, valid_list_hyps f -> valid_list_goal f. + +unfold valid_list_goal in |- *; intros f H e lp H1; apply goal_to_hyps; + intro H2; apply list_hyps_to_goal with (1 := H1); + apply (H e lp); assumption. +Qed. Theorem append_valid : - (e: (list Z)) (l1,l2:lhyps) - (interp_list_hyps e l1) \/ (interp_list_hyps e l2) -> - (interp_list_hyps e (app l1 l2)). + forall (e:list Z) (l1 l2:lhyps), + interp_list_hyps e l1 \/ interp_list_hyps e l2 -> + interp_list_hyps e (l1 ++ l2). -Intros e; Induction l1; [ - Simpl; Intros l2 [H | H]; [ Contradiction | Trivial ] -| Simpl; Intros h1 t1 HR l2 [[H | H] | H] ;[ - Auto - | Right; Apply (HR l2); Left; Trivial - | Right; Apply (HR l2); Right; Trivial ]]. +intros e; simple induction l1; + [ simpl in |- *; intros l2 [H| H]; [ contradiction | trivial ] + | simpl in |- *; intros h1 t1 HR l2 [[H| H]| H]; + [ auto + | right; apply (HR l2); left; trivial + | right; apply (HR l2); right; trivial ] ]. -Save. +Qed. (* \subsubsection{Opérateurs valides sur les hypothèses} *) (* Extraire une hypothèse de la liste *) -Definition nth_hyps [n:nat; l: hyps] := (nth n l TrueTerm). +Definition nth_hyps (n:nat) (l:hyps) := nth n l TrueTerm. Theorem nth_valid : - (e: (list Z); i:nat; l: hyps) - (interp_hyps e l) -> (interp_proposition e (nth_hyps i l)). + forall (e:list Z) (i:nat) (l:hyps), + interp_hyps e l -> interp_proposition e (nth_hyps i l). -Unfold nth_hyps; Induction i; [ - Induction l; Simpl; [ Auto | Intros; Elim H0; Auto ] -| Intros n H; Induction l; - [ Simpl; Trivial | Intros; Simpl; Apply H; Elim H1; Auto ]]. -Save. +unfold nth_hyps in |- *; simple induction i; + [ simple induction l; simpl in |- *; [ auto | intros; elim H0; auto ] + | intros n H; simple induction l; + [ simpl in |- *; trivial + | intros; simpl in |- *; apply H; elim H1; auto ] ]. +Qed. (* Appliquer une opération (valide) sur deux hypothèses extraites de la liste et ajouter le résultat à la liste. *) -Definition apply_oper_2 - [i,j : nat; f : proposition -> proposition -> proposition ] := - [l: hyps] (cons (f (nth_hyps i l) (nth_hyps j l)) l). +Definition apply_oper_2 (i j:nat) + (f:proposition -> proposition -> proposition) (l:hyps) := + f (nth_hyps i l) (nth_hyps j l) :: l. Theorem apply_oper_2_valid : - (i,j : nat; f : proposition -> proposition -> proposition ) - (valid2 f) -> (valid_hyps (apply_oper_2 i j f)). + forall (i j:nat) (f:proposition -> proposition -> proposition), + valid2 f -> valid_hyps (apply_oper_2 i j f). -Intros i j f Hf; Unfold apply_oper_2 valid_hyps; Simpl; Intros lp Hlp; Split; - [ Apply Hf; Apply nth_valid; Assumption | Assumption]. -Save. +intros i j f Hf; unfold apply_oper_2, valid_hyps in |- *; simpl in |- *; + intros lp Hlp; split; [ apply Hf; apply nth_valid; assumption | assumption ]. +Qed. (* Modifier une hypothèse par application d'une opération valide *) -Fixpoint apply_oper_1 [i:nat] : (proposition -> proposition) -> hyps -> hyps := - [f : (proposition -> proposition); l : hyps] - Cases l of - nil => (nil proposition) - | (cons p l') => - Cases i of - O => (cons (f p) l') - | (S j) => (cons p (apply_oper_1 j f l')) - end - end. +Fixpoint apply_oper_1 (i:nat) (f:proposition -> proposition) + (l:hyps) {struct i} : hyps := + match l with + | nil => nil (A:=proposition) + | p :: l' => + match i with + | O => f p :: l' + | S j => p :: apply_oper_1 j f l' + end + end. Theorem apply_oper_1_valid : - (i : nat; f : proposition -> proposition ) - (valid1 f) -> (valid_hyps (apply_oper_1 i f)). + forall (i:nat) (f:proposition -> proposition), + valid1 f -> valid_hyps (apply_oper_1 i f). -Unfold valid_hyps; Intros i f Hf e; Elim i; [ - Intro lp; Case lp; [ - Simpl; Trivial - | Simpl; Intros p l' (H1, H2); Split; [ Apply Hf with 1:=H1 | Assumption ]] -| Intros n Hrec lp; Case lp; [ - Simpl; Auto - | Simpl; Intros p l' (H1, H2); - Split; [ Assumption | Apply Hrec; Assumption ]]]. +unfold valid_hyps in |- *; intros i f Hf e; elim i; + [ intro lp; case lp; + [ simpl in |- *; trivial + | simpl in |- *; intros p l' [H1 H2]; split; + [ apply Hf with (1 := H1) | assumption ] ] + | intros n Hrec lp; case lp; + [ simpl in |- *; auto + | simpl in |- *; intros p l' [H1 H2]; split; + [ assumption | apply Hrec; assumption ] ] ]. -Save. +Qed. (* \subsubsection{Manipulations de termes} *) (* Les fonctions suivantes permettent d'appliquer une fonction de @@ -541,25 +586,25 @@ Save. cela permet de construire des réécritures complexes proches des tactiques de conversion *) -Definition apply_left [f: term -> term; t : term]:= - Cases t of - (Tplus x y) => (Tplus (f x) y) - | (Tmult x y) => (Tmult (f x) y) - | (Topp x) => (Topp (f x)) +Definition apply_left (f:term -> term) (t:term) := + match t with + | Tplus x y => Tplus (f x) y + | Tmult x y => Tmult (f x) y + | Topp x => Topp (f x) | x => x end. -Definition apply_right [f: term -> term; t : term]:= - Cases t of - (Tplus x y) => (Tplus x (f y)) - | (Tmult x y) => (Tmult x (f y)) +Definition apply_right (f:term -> term) (t:term) := + match t with + | Tplus x y => Tplus x (f y) + | Tmult x y => Tmult x (f y) | x => x end. -Definition apply_both [f,g: term -> term; t : term]:= - Cases t of - (Tplus x y) => (Tplus (f x) (g y)) - | (Tmult x y) => (Tmult (f x) (g y)) +Definition apply_both (f g:term -> term) (t:term) := + match t with + | Tplus x y => Tplus (f x) (g y) + | Tmult x y => Tmult (f x) (g y) | x => x end. @@ -567,33 +612,33 @@ Definition apply_both [f,g: term -> term; t : term]:= fonctions. *) Theorem apply_left_stable : - (f: term -> term) (term_stable f) -> (term_stable (apply_left f)). + forall f:term -> term, term_stable f -> term_stable (apply_left f). -Unfold term_stable; Intros f H e t; Case t; Auto; Simpl; -Intros; Elim H; Trivial. -Save. +unfold term_stable in |- *; intros f H e t; case t; auto; simpl in |- *; + intros; elim H; trivial. +Qed. Theorem apply_right_stable : - (f: term -> term) (term_stable f) -> (term_stable (apply_right f)). + forall f:term -> term, term_stable f -> term_stable (apply_right f). -Unfold term_stable; Intros f H e t; Case t; Auto; Simpl; -Intros t0 t1; Elim H; Trivial. -Save. +unfold term_stable in |- *; intros f H e t; case t; auto; simpl in |- *; + intros t0 t1; elim H; trivial. +Qed. Theorem apply_both_stable : - (f,g: term -> term) (term_stable f) -> (term_stable g) -> - (term_stable (apply_both f g)). + forall f g:term -> term, + term_stable f -> term_stable g -> term_stable (apply_both f g). -Unfold term_stable; Intros f g H1 H2 e t; Case t; Auto; Simpl; -Intros t0 t1; Elim H1; Elim H2; Trivial. -Save. +unfold term_stable in |- *; intros f g H1 H2 e t; case t; auto; simpl in |- *; + intros t0 t1; elim H1; elim H2; trivial. +Qed. Theorem compose_term_stable : - (f,g: term -> term) (term_stable f) -> (term_stable g) -> - (term_stable [t: term](f (g t))). + forall f g:term -> term, + term_stable f -> term_stable g -> term_stable (fun t:term => f (g t)). -Unfold term_stable; Intros f g Hf Hg e t; Elim Hf; Apply Hg. -Save. +unfold term_stable in |- *; intros f g Hf Hg e t; elim Hf; apply Hg. +Qed. (* \subsection{Les règles de réécriture} *) (* Chacune des règles de réécriture est accompagnée par sa preuve de @@ -623,362 +668,385 @@ Save. *) (* \subsubsection{La tactique pour prouver la stabilité} *) -Recursive Tactic Definition loop t := ( - Match t With - (* Global *) - [(?1 = ?2)] -> (loop ?1) Orelse (loop ?2) - | [ ? -> ?1 ] -> (loop ?1) +Ltac loop t := + match constr:t with + | (?X1 = ?X2) => + (* Global *) + loop X1 || loop X2 + | (_ -> ?X1) => loop X1 + | (interp_hyps _ ?X1) => + (* Interprétations *) - | [ (interp_hyps ? ?1) ] -> (loop ?1) - | [ (interp_list_hyps ? ?1) ] -> (loop ?1) - | [ (interp_proposition ? ?1) ] -> (loop ?1) - | [ (interp_term ? ?1) ] -> (loop ?1) - (* Propositions *) - | [(EqTerm ?1 ?2)] -> (loop ?1) Orelse (loop ?2) - | [(LeqTerm ?1 ?2)] -> (loop ?1) Orelse (loop ?2) - (* Termes *) - | [(Tplus ?1 ?2)] -> (loop ?1) Orelse (loop ?2) - | [(Tminus ?1 ?2)] -> (loop ?1) Orelse (loop ?2) - | [(Tmult ?1 ?2)] -> (loop ?1) Orelse (loop ?2) - | [(Topp ?1)] -> (loop ?1) - | [(Tint ?1)] -> (loop ?1) - (* Eliminations *) - | [(Cases ?1 of - | (EqTerm _ _) => ? - | (LeqTerm _ _) => ? - | TrueTerm => ? - | FalseTerm => ? - | (Tnot _) => ? - | (GeqTerm _ _) => ? - | (GtTerm _ _) => ? - | (LtTerm _ _) => ? - | (NeqTerm _ _) => ? - end)] -> - (Case ?1; [ Intro; Intro | Intro; Intro | Idtac | Idtac - | Intro | Intro; Intro | Intro; Intro | Intro; Intro - | Intro; Intro ]); - Auto; Simplify - | [(Cases ?1 of - (Tint _) => ? - | (Tplus _ _) => ? - | (Tmult _ _) => ? - | (Tminus _ _) => ? - | (Topp _) => ? - | (Tvar _) => ? - end)] -> - (Case ?1; [ Intro | Intro; Intro | Intro; Intro | Intro; Intro | - Intro | Intro ]); Auto; Simplify - | [(Cases (Zcompare ?1 ?2) of - EGAL => ? - | INFERIEUR => ? - | SUPERIEUR => ? - end)] -> - (Elim_Zcompare ?1 ?2) ; Intro ; Auto; Simplify - | [(Cases ?1 of ZERO => ? | (POS _) => ? | (NEG _) => ? end)] -> - (Case ?1; [ Idtac | Intro | Intro ]); Auto; Simplify - | [(if (eq_Z ?1 ?2) then ? else ?)] -> - ((Elim_eq_Z ?1 ?2); Intro H; [Rewrite H; Clear H | Clear H]); - Simpl; Auto; Simplify - | [(if (eq_term ?1 ?2) then ? else ?)] -> - ((Elim_eq_term ?1 ?2); Intro H; [Rewrite H; Clear H | Clear H]); - Simpl; Auto; Simplify - | [(if (eq_pos ?1 ?2) then ? else ?)] -> - ((Elim_eq_pos ?1 ?2); Intro H; [Rewrite H; Clear H | Clear H]); - Simpl; Auto; Simplify - | _ -> Fail) -And Simplify := ( - Match Context With [|- ?1 ] -> Try (loop ?1) | _ -> Idtac). - -Tactic Definition ProveStable x th := - Unfold term_stable x; Intros; Simplify; Simpl; Apply th. + loop X1 + | (interp_list_hyps _ ?X1) => loop X1 + | (interp_proposition _ ?X1) => loop X1 + | (interp_term _ ?X1) => loop X1 + | (EqTerm ?X1 ?X2) => + + (* Propositions *) + loop X1 || loop X2 + | (LeqTerm ?X1 ?X2) => loop X1 || loop X2 + | (Tplus ?X1 ?X2) => + (* Termes *) + loop X1 || loop X2 + | (Tminus ?X1 ?X2) => loop X1 || loop X2 + | (Tmult ?X1 ?X2) => loop X1 || loop X2 + | (Topp ?X1) => loop X1 + | (Tint ?X1) => + loop X1 + | match ?X1 with + | EqTerm x x0 => _ + | LeqTerm x x0 => _ + | TrueTerm => _ + | FalseTerm => _ + | Tnot x => _ + | GeqTerm x x0 => _ + | GtTerm x x0 => _ + | LtTerm x x0 => _ + | NeqTerm x x0 => _ + end => + + (* Eliminations *) + case X1; + [ intro; intro + | intro; intro + | idtac + | idtac + | intro + | intro; intro + | intro; intro + | intro; intro + | intro; intro ]; auto; Simplify + | match ?X1 with + | Tint x => _ + | Tplus x x0 => _ + | Tmult x x0 => _ + | Tminus x x0 => _ + | Topp x => _ + | Tvar x => _ + end => + case X1; + [ intro | intro; intro | intro; intro | intro; intro | intro | intro ]; + auto; Simplify + | match (?X1 ?= ?X2)%Z with + | Datatypes.Eq => _ + | Datatypes.Lt => _ + | Datatypes.Gt => _ + end => + elim_Zcompare X1 X2; intro; auto; Simplify + | match ?X1 with + | Z0 => _ + | Zpos x => _ + | Zneg x => _ + end => + case X1; [ idtac | intro | intro ]; auto; Simplify + | (if eq_Z ?X1 ?X2 then _ else _) => + elim_eq_Z X1 X2; intro H; [ rewrite H; clear H | clear H ]; + simpl in |- *; auto; Simplify + | (if eq_term ?X1 ?X2 then _ else _) => + elim_eq_term X1 X2; intro H; [ rewrite H; clear H | clear H ]; + simpl in |- *; auto; Simplify + | (if eq_pos ?X1 ?X2 then _ else _) => + elim_eq_pos X1 X2; intro H; [ rewrite H; clear H | clear H ]; + simpl in |- *; auto; Simplify + | _ => fail + end + with Simplify := match goal with + | |- ?X1 => try loop X1 + | _ => idtac + end. + +Ltac prove_stable x th := + unfold term_stable, x in |- *; intros; Simplify; simpl in |- *; apply th. (* \subsubsection{Les règles elle mêmes} *) -Definition Tplus_assoc_l [t: term] := - Cases t of - (Tplus n (Tplus m p)) => (Tplus (Tplus n m) p) +Definition Tplus_assoc_l (t:term) := + match t with + | Tplus n (Tplus m p) => Tplus (Tplus n m) p | _ => t end. -Theorem Tplus_assoc_l_stable : (term_stable Tplus_assoc_l). +Theorem Tplus_assoc_l_stable : term_stable Tplus_assoc_l. -(ProveStable Tplus_assoc_l Zplus_assoc). -Save. +prove_stable Tplus_assoc_l Zplus_assoc. +Qed. -Definition Tplus_assoc_r [t: term] := - Cases t of - (Tplus (Tplus n m) p) => (Tplus n (Tplus m p)) +Definition Tplus_assoc_r (t:term) := + match t with + | Tplus (Tplus n m) p => Tplus n (Tplus m p) | _ => t end. -Theorem Tplus_assoc_r_stable : (term_stable Tplus_assoc_r). +Theorem Tplus_assoc_r_stable : term_stable Tplus_assoc_r. -(ProveStable Tplus_assoc_r Zplus_assoc_r). -Save. +prove_stable Tplus_assoc_r Zplus_assoc_reverse. +Qed. -Definition Tmult_assoc_r [t: term] := - Cases t of - (Tmult (Tmult n m) p) => (Tmult n (Tmult m p)) +Definition Tmult_assoc_r (t:term) := + match t with + | Tmult (Tmult n m) p => Tmult n (Tmult m p) | _ => t end. -Theorem Tmult_assoc_r_stable : (term_stable Tmult_assoc_r). +Theorem Tmult_assoc_r_stable : term_stable Tmult_assoc_r. -(ProveStable Tmult_assoc_r Zmult_assoc_r). -Save. +prove_stable Tmult_assoc_r Zmult_assoc_reverse. +Qed. -Definition Tplus_permute [t: term] := - Cases t of - (Tplus n (Tplus m p)) => (Tplus m (Tplus n p)) +Definition Tplus_permute (t:term) := + match t with + | Tplus n (Tplus m p) => Tplus m (Tplus n p) | _ => t end. -Theorem Tplus_permute_stable : (term_stable Tplus_permute). +Theorem Tplus_permute_stable : term_stable Tplus_permute. -(ProveStable Tplus_permute Zplus_permute). -Save. +prove_stable Tplus_permute Zplus_permute. +Qed. -Definition Tplus_sym [t: term] := - Cases t of - (Tplus x y) => (Tplus y x) +Definition Tplus_sym (t:term) := + match t with + | Tplus x y => Tplus y x | _ => t end. -Theorem Tplus_sym_stable : (term_stable Tplus_sym). +Theorem Tplus_sym_stable : term_stable Tplus_sym. -(ProveStable Tplus_sym Zplus_sym). -Save. +prove_stable Tplus_sym Zplus_comm. +Qed. -Definition Tmult_sym [t: term] := - Cases t of - (Tmult x y) => (Tmult y x) +Definition Tmult_sym (t:term) := + match t with + | Tmult x y => Tmult y x | _ => t end. -Theorem Tmult_sym_stable : (term_stable Tmult_sym). +Theorem Tmult_sym_stable : term_stable Tmult_sym. -(ProveStable Tmult_sym Zmult_sym). -Save. +prove_stable Tmult_sym Zmult_comm. +Qed. -Definition T_OMEGA10 [t: term] := - Cases t of - (Tplus (Tmult (Tplus (Tmult v (Tint c1)) l1) (Tint k1)) - (Tmult (Tplus (Tmult v' (Tint c2)) l2) (Tint k2))) => - Case (eq_term v v') of - (Tplus (Tmult v (Tint (Zplus (Zmult c1 k1) (Zmult c2 k2)))) - (Tplus (Tmult l1 (Tint k1)) (Tmult l2 (Tint k2)))) - t - end +Definition T_OMEGA10 (t:term) := + match t with + | Tplus (Tmult (Tplus (Tmult v (Tint c1)) l1) (Tint k1)) (Tmult (Tplus + (Tmult v' (Tint c2)) l2) (Tint k2)) => + match eq_term v v' with + | true => + Tplus (Tmult v (Tint (c1 * k1 + c2 * k2))) + (Tplus (Tmult l1 (Tint k1)) (Tmult l2 (Tint k2))) + | false => t + end | _ => t end. -Theorem T_OMEGA10_stable : (term_stable T_OMEGA10). +Theorem T_OMEGA10_stable : term_stable T_OMEGA10. -(ProveStable T_OMEGA10 OMEGA10). -Save. +prove_stable T_OMEGA10 OMEGA10. +Qed. -Definition T_OMEGA11 [t: term] := - Cases t of - (Tplus (Tmult (Tplus (Tmult v1 (Tint c1)) l1) (Tint k1)) l2) => - (Tplus (Tmult v1 (Tint (Zmult c1 k1))) (Tplus (Tmult l1 (Tint k1)) l2)) +Definition T_OMEGA11 (t:term) := + match t with + | Tplus (Tmult (Tplus (Tmult v1 (Tint c1)) l1) (Tint k1)) l2 => + Tplus (Tmult v1 (Tint (c1 * k1))) (Tplus (Tmult l1 (Tint k1)) l2) | _ => t end. -Theorem T_OMEGA11_stable : (term_stable T_OMEGA11). +Theorem T_OMEGA11_stable : term_stable T_OMEGA11. -(ProveStable T_OMEGA11 OMEGA11). -Save. +prove_stable T_OMEGA11 OMEGA11. +Qed. -Definition T_OMEGA12 [t: term] := - Cases t of - (Tplus l1 (Tmult (Tplus (Tmult v2 (Tint c2)) l2) (Tint k2))) => - (Tplus (Tmult v2 (Tint (Zmult c2 k2))) (Tplus l1 (Tmult l2 (Tint k2)))) +Definition T_OMEGA12 (t:term) := + match t with + | Tplus l1 (Tmult (Tplus (Tmult v2 (Tint c2)) l2) (Tint k2)) => + Tplus (Tmult v2 (Tint (c2 * k2))) (Tplus l1 (Tmult l2 (Tint k2))) | _ => t end. -Theorem T_OMEGA12_stable : (term_stable T_OMEGA12). - -(ProveStable T_OMEGA12 OMEGA12). -Save. - -Definition T_OMEGA13 [t: term] := - Cases t of - (Tplus (Tplus (Tmult v (Tint (POS x))) l1) - (Tplus (Tmult v' (Tint (NEG x'))) l2)) => - Case (eq_term v v') of - Case (eq_pos x x') of - (Tplus l1 l2) - t - end - t - end - | (Tplus (Tplus (Tmult v (Tint (NEG x))) l1) - (Tplus (Tmult v' (Tint (POS x'))) l2)) => - Case (eq_term v v') of - Case (eq_pos x x') of - (Tplus l1 l2) - t - end - t - end - +Theorem T_OMEGA12_stable : term_stable T_OMEGA12. + +prove_stable T_OMEGA12 OMEGA12. +Qed. + +Definition T_OMEGA13 (t:term) := + match t with + | Tplus (Tplus (Tmult v (Tint (Zpos x))) l1) (Tplus (Tmult v' (Tint (Zneg + x'))) l2) => + match eq_term v v' with + | true => match eq_pos x x' with + | true => Tplus l1 l2 + | false => t + end + | false => t + end + | Tplus (Tplus (Tmult v (Tint (Zneg x))) l1) (Tplus (Tmult v' (Tint (Zpos + x'))) l2) => + match eq_term v v' with + | true => match eq_pos x x' with + | true => Tplus l1 l2 + | false => t + end + | false => t + end | _ => t end. -Theorem T_OMEGA13_stable : (term_stable T_OMEGA13). - -Unfold term_stable T_OMEGA13; Intros; Simplify; Simpl; - [ Apply OMEGA13 | Apply OMEGA14 ]. -Save. - -Definition T_OMEGA15 [t: term] := - Cases t of - (Tplus (Tplus (Tmult v (Tint c1)) l1) - (Tmult (Tplus (Tmult v' (Tint c2)) l2) (Tint k2))) => - Case (eq_term v v') of - (Tplus (Tmult v (Tint (Zplus c1 (Zmult c2 k2)))) - (Tplus l1 (Tmult l2 (Tint k2)))) - t - end +Theorem T_OMEGA13_stable : term_stable T_OMEGA13. + +unfold term_stable, T_OMEGA13 in |- *; intros; Simplify; simpl in |- *; + [ apply OMEGA13 | apply OMEGA14 ]. +Qed. + +Definition T_OMEGA15 (t:term) := + match t with + | Tplus (Tplus (Tmult v (Tint c1)) l1) (Tmult (Tplus (Tmult v' (Tint c2)) + l2) (Tint k2)) => + match eq_term v v' with + | true => + Tplus (Tmult v (Tint (c1 + c2 * k2))) + (Tplus l1 (Tmult l2 (Tint k2))) + | false => t + end | _ => t end. -Theorem T_OMEGA15_stable : (term_stable T_OMEGA15). +Theorem T_OMEGA15_stable : term_stable T_OMEGA15. -(ProveStable T_OMEGA15 OMEGA15). -Save. +prove_stable T_OMEGA15 OMEGA15. +Qed. -Definition T_OMEGA16 [t: term] := - Cases t of - (Tmult (Tplus (Tmult v (Tint c)) l) (Tint k)) => - (Tplus (Tmult v (Tint (Zmult c k))) (Tmult l (Tint k))) +Definition T_OMEGA16 (t:term) := + match t with + | Tmult (Tplus (Tmult v (Tint c)) l) (Tint k) => + Tplus (Tmult v (Tint (c * k))) (Tmult l (Tint k)) | _ => t end. -Theorem T_OMEGA16_stable : (term_stable T_OMEGA16). +Theorem T_OMEGA16_stable : term_stable T_OMEGA16. -(ProveStable T_OMEGA16 OMEGA16). -Save. +prove_stable T_OMEGA16 OMEGA16. +Qed. -Definition Tred_factor5 [t: term] := - Cases t of - (Tplus (Tmult x (Tint ZERO)) y) => y - | _ => t - end. +Definition Tred_factor5 (t:term) := + match t with + | Tplus (Tmult x (Tint Z0)) y => y + | _ => t + end. -Theorem Tred_factor5_stable : (term_stable Tred_factor5). +Theorem Tred_factor5_stable : term_stable Tred_factor5. -(ProveStable Tred_factor5 Zred_factor5). -Save. +prove_stable Tred_factor5 Zred_factor5. +Qed. -Definition Topp_plus [t: term] := - Cases t of - (Topp (Tplus x y)) => (Tplus (Topp x) (Topp y)) +Definition Topp_plus (t:term) := + match t with + | Topp (Tplus x y) => Tplus (Topp x) (Topp y) | _ => t end. -Theorem Topp_plus_stable : (term_stable Topp_plus). +Theorem Topp_plus_stable : term_stable Topp_plus. -(ProveStable Topp_plus Zopp_Zplus). -Save. +prove_stable Topp_plus Zopp_plus_distr. +Qed. -Definition Topp_opp [t: term] := - Cases t of - (Topp (Topp x)) => x +Definition Topp_opp (t:term) := + match t with + | Topp (Topp x) => x | _ => t end. -Theorem Topp_opp_stable : (term_stable Topp_opp). +Theorem Topp_opp_stable : term_stable Topp_opp. -(ProveStable Topp_opp Zopp_Zopp). -Save. +prove_stable Topp_opp Zopp_involutive. +Qed. -Definition Topp_mult_r [t: term] := - Cases t of - (Topp (Tmult x (Tint k))) => (Tmult x (Tint (Zopp k))) +Definition Topp_mult_r (t:term) := + match t with + | Topp (Tmult x (Tint k)) => Tmult x (Tint (- k)) | _ => t end. -Theorem Topp_mult_r_stable : (term_stable Topp_mult_r). +Theorem Topp_mult_r_stable : term_stable Topp_mult_r. -(ProveStable Topp_mult_r Zopp_Zmult_r). -Save. +prove_stable Topp_mult_r Zopp_mult_distr_r. +Qed. -Definition Topp_one [t: term] := - Cases t of - (Topp x) => (Tmult x (Tint `-1`)) +Definition Topp_one (t:term) := + match t with + | Topp x => Tmult x (Tint (-1)) | _ => t end. -Theorem Topp_one_stable : (term_stable Topp_one). +Theorem Topp_one_stable : term_stable Topp_one. -(ProveStable Topp_one Zopp_one). -Save. +prove_stable Topp_one Zopp_eq_mult_neg_1. +Qed. -Definition Tmult_plus_distr [t: term] := - Cases t of - (Tmult (Tplus n m) p) => (Tplus (Tmult n p) (Tmult m p)) +Definition Tmult_plus_distr (t:term) := + match t with + | Tmult (Tplus n m) p => Tplus (Tmult n p) (Tmult m p) | _ => t end. -Theorem Tmult_plus_distr_stable : (term_stable Tmult_plus_distr). +Theorem Tmult_plus_distr_stable : term_stable Tmult_plus_distr. -(ProveStable Tmult_plus_distr Zmult_plus_distr_l). -Save. +prove_stable Tmult_plus_distr Zmult_plus_distr_l. +Qed. -Definition Tmult_opp_left [t: term] := - Cases t of - (Tmult (Topp x) (Tint y)) => (Tmult x (Tint (Zopp y))) +Definition Tmult_opp_left (t:term) := + match t with + | Tmult (Topp x) (Tint y) => Tmult x (Tint (- y)) | _ => t end. -Theorem Tmult_opp_left_stable : (term_stable Tmult_opp_left). +Theorem Tmult_opp_left_stable : term_stable Tmult_opp_left. -(ProveStable Tmult_opp_left Zmult_Zopp_left). -Save. +prove_stable Tmult_opp_left Zmult_opp_comm. +Qed. -Definition Tmult_assoc_reduced [t: term] := - Cases t of - (Tmult (Tmult n (Tint m)) (Tint p)) => (Tmult n (Tint (Zmult m p))) +Definition Tmult_assoc_reduced (t:term) := + match t with + | Tmult (Tmult n (Tint m)) (Tint p) => Tmult n (Tint (m * p)) | _ => t end. -Theorem Tmult_assoc_reduced_stable : (term_stable Tmult_assoc_reduced). +Theorem Tmult_assoc_reduced_stable : term_stable Tmult_assoc_reduced. -(ProveStable Tmult_assoc_reduced Zmult_assoc_r). -Save. +prove_stable Tmult_assoc_reduced Zmult_assoc_reverse. +Qed. -Definition Tred_factor0 [t: term] := (Tmult t (Tint `1`)). +Definition Tred_factor0 (t:term) := Tmult t (Tint 1). -Theorem Tred_factor0_stable : (term_stable Tred_factor0). +Theorem Tred_factor0_stable : term_stable Tred_factor0. -(ProveStable Tred_factor0 Zred_factor0). -Save. +prove_stable Tred_factor0 Zred_factor0. +Qed. -Definition Tred_factor1 [t: term] := - Cases t of - (Tplus x y) => - Case (eq_term x y) of - (Tmult x (Tint `2`)) - t - end +Definition Tred_factor1 (t:term) := + match t with + | Tplus x y => + match eq_term x y with + | true => Tmult x (Tint 2) + | false => t + end | _ => t end. -Theorem Tred_factor1_stable : (term_stable Tred_factor1). +Theorem Tred_factor1_stable : term_stable Tred_factor1. -(ProveStable Tred_factor1 Zred_factor1). -Save. +prove_stable Tred_factor1 Zred_factor1. +Qed. -Definition Tred_factor2 [t: term] := - Cases t of - (Tplus x (Tmult y (Tint k))) => - Case (eq_term x y) of - (Tmult x (Tint (Zplus `1` k))) - t - end +Definition Tred_factor2 (t:term) := + match t with + | Tplus x (Tmult y (Tint k)) => + match eq_term x y with + | true => Tmult x (Tint (1 + k)) + | false => t + end | _ => t end. @@ -987,61 +1055,61 @@ Definition Tred_factor2 [t: term] := Opaque Zplus. -Theorem Tred_factor2_stable : (term_stable Tred_factor2). -(ProveStable Tred_factor2 Zred_factor2). -Save. - -Definition Tred_factor3 [t: term] := - Cases t of - (Tplus (Tmult x (Tint k)) y) => - Case (eq_term x y) of - (Tmult x (Tint `1+k`)) - t - end +Theorem Tred_factor2_stable : term_stable Tred_factor2. +prove_stable Tred_factor2 Zred_factor2. +Qed. + +Definition Tred_factor3 (t:term) := + match t with + | Tplus (Tmult x (Tint k)) y => + match eq_term x y with + | true => Tmult x (Tint (1 + k)) + | false => t + end | _ => t end. -Theorem Tred_factor3_stable : (term_stable Tred_factor3). +Theorem Tred_factor3_stable : term_stable Tred_factor3. -(ProveStable Tred_factor3 Zred_factor3). -Save. +prove_stable Tred_factor3 Zred_factor3. +Qed. -Definition Tred_factor4 [t: term] := - Cases t of - (Tplus (Tmult x (Tint k1)) (Tmult y (Tint k2))) => - Case (eq_term x y) of - (Tmult x (Tint `k1+k2`)) - t - end +Definition Tred_factor4 (t:term) := + match t with + | Tplus (Tmult x (Tint k1)) (Tmult y (Tint k2)) => + match eq_term x y with + | true => Tmult x (Tint (k1 + k2)) + | false => t + end | _ => t end. -Theorem Tred_factor4_stable : (term_stable Tred_factor4). +Theorem Tred_factor4_stable : term_stable Tred_factor4. -(ProveStable Tred_factor4 Zred_factor4). -Save. +prove_stable Tred_factor4 Zred_factor4. +Qed. -Definition Tred_factor6 [t: term] := (Tplus t (Tint `0`)). +Definition Tred_factor6 (t:term) := Tplus t (Tint 0). -Theorem Tred_factor6_stable : (term_stable Tred_factor6). +Theorem Tred_factor6_stable : term_stable Tred_factor6. -(ProveStable Tred_factor6 Zred_factor6). -Save. +prove_stable Tred_factor6 Zred_factor6. +Qed. Transparent Zplus. -Definition Tminus_def [t:term] := - Cases t of - (Tminus x y) => (Tplus x (Topp y)) +Definition Tminus_def (t:term) := + match t with + | Tminus x y => Tplus x (Topp y) | _ => t end. -Theorem Tminus_def_stable : (term_stable Tminus_def). +Theorem Tminus_def_stable : term_stable Tminus_def. (* Le théorème ne sert à rien. Le but est prouvé avant. *) -(ProveStable Tminus_def False). -Save. +prove_stable Tminus_def False. +Qed. (* \subsection{Fonctions de réécriture complexes} *) @@ -1050,56 +1118,57 @@ Save. suffit pour cela d'échanger le constructeur [Tint] avec les opérateurs réifiés. La réduction est ``gratuite''. *) -Fixpoint reduce [t:term] : term := - Cases t of - (Tplus x y) => - Cases (reduce x) of - (Tint x') => - Cases (reduce y) of - (Tint y') => (Tint (Zplus x' y')) - | y' => (Tplus (Tint x') y') - end - | x' => (Tplus x' (reduce y)) - end - | (Tmult x y) => - Cases (reduce x) of - (Tint x') => - Cases (reduce y) of - (Tint y') => (Tint (Zmult x' y')) - | y' => (Tmult (Tint x') y') - end - | x' => (Tmult x' (reduce y)) - end - | (Tminus x y) => - Cases (reduce x) of - (Tint x') => - Cases (reduce y) of - (Tint y') => (Tint (Zminus x' y')) - | y' => (Tminus (Tint x') y') - end - | x' => (Tminus x' (reduce y)) - end - | (Topp x) => - Cases (reduce x) of - (Tint x') => (Tint (Zopp x')) - | x' => (Topp x') - end +Fixpoint reduce (t:term) : term := + match t with + | Tplus x y => + match reduce x with + | Tint x' => + match reduce y with + | Tint y' => Tint (x' + y') + | y' => Tplus (Tint x') y' + end + | x' => Tplus x' (reduce y) + end + | Tmult x y => + match reduce x with + | Tint x' => + match reduce y with + | Tint y' => Tint (x' * y') + | y' => Tmult (Tint x') y' + end + | x' => Tmult x' (reduce y) + end + | Tminus x y => + match reduce x with + | Tint x' => + match reduce y with + | Tint y' => Tint (x' - y') + | y' => Tminus (Tint x') y' + end + | x' => Tminus x' (reduce y) + end + | Topp x => + match reduce x with + | Tint x' => Tint (- x') + | x' => Topp x' + end | _ => t end. -Theorem reduce_stable : (term_stable reduce). - -Unfold term_stable; Intros e t; Elim t; Auto; -Try (Intros t0 H0 t1 H1; Simpl; Rewrite H0; Rewrite H1; ( - Case (reduce t0); [ - Intro z0; Case (reduce t1); Intros; Auto - | Intros; Auto - | Intros; Auto - | Intros; Auto - | Intros; Auto - | Intros; Auto ])); -Intros t0 H0; Simpl; Rewrite H0; Case (reduce t0); Intros; Auto. -Save. +Theorem reduce_stable : term_stable reduce. + +unfold term_stable in |- *; intros e t; elim t; auto; + try + (intros t0 H0 t1 H1; simpl in |- *; rewrite H0; rewrite H1; + (case (reduce t0); + [ intro z0; case (reduce t1); intros; auto + | intros; auto + | intros; auto + | intros; auto + | intros; auto + | intros; auto ])); intros t0 H0; simpl in |- *; + rewrite H0; case (reduce t0); intros; auto. +Qed. (* \subsubsection{Fusions} \paragraph{Fusion de deux équations} *) @@ -1108,407 +1177,413 @@ Save. le terme en une équation normalisée. C'est une version très simplifiée du moteur de réécriture [rewrite]. *) -Fixpoint fusion [trace : (list t_fusion)] : term -> term := [t: term] - Cases trace of - nil => (reduce t) - | (cons step trace') => - Cases step of - | F_equal => - (apply_right (fusion trace') (T_OMEGA10 t)) - | F_cancel => - (fusion trace' (Tred_factor5 (T_OMEGA10 t))) - | F_left => - (apply_right (fusion trace') (T_OMEGA11 t)) - | F_right => - (apply_right (fusion trace') (T_OMEGA12 t)) - end +Fixpoint fusion (trace:list t_fusion) (t:term) {struct trace} : term := + match trace with + | nil => reduce t + | step :: trace' => + match step with + | F_equal => apply_right (fusion trace') (T_OMEGA10 t) + | F_cancel => fusion trace' (Tred_factor5 (T_OMEGA10 t)) + | F_left => apply_right (fusion trace') (T_OMEGA11 t) + | F_right => apply_right (fusion trace') (T_OMEGA12 t) + end end. -Theorem fusion_stable : (t : (list t_fusion)) (term_stable (fusion t)). - -Induction t; Simpl; [ - Exact reduce_stable -| Intros step l H; Case step; [ - Apply compose_term_stable; - [ Apply apply_right_stable; Assumption | Exact T_OMEGA10_stable ] - | Unfold term_stable; Intros e t1; Rewrite T_OMEGA10_stable; - Rewrite Tred_factor5_stable; Apply H - | Apply compose_term_stable; - [ Apply apply_right_stable; Assumption | Exact T_OMEGA11_stable ] - | Apply compose_term_stable; - [ Apply apply_right_stable; Assumption | Exact T_OMEGA12_stable ]]]. - -Save. +Theorem fusion_stable : forall t:list t_fusion, term_stable (fusion t). + +simple induction t; simpl in |- *; + [ exact reduce_stable + | intros step l H; case step; + [ apply compose_term_stable; + [ apply apply_right_stable; assumption | exact T_OMEGA10_stable ] + | unfold term_stable in |- *; intros e t1; rewrite T_OMEGA10_stable; + rewrite Tred_factor5_stable; apply H + | apply compose_term_stable; + [ apply apply_right_stable; assumption | exact T_OMEGA11_stable ] + | apply compose_term_stable; + [ apply apply_right_stable; assumption | exact T_OMEGA12_stable ] ] ]. + +Qed. (* \paragraph{Fusion de deux équations dont une sans coefficient} *) -Definition fusion_right [trace : (list t_fusion)] : term -> term := [t: term] - Cases trace of - nil => (reduce t) (* Il faut mettre un compute *) - | (cons step trace') => - Cases step of - | F_equal => - (apply_right (fusion trace') (T_OMEGA15 t)) - | F_cancel => - (fusion trace' (Tred_factor5 (T_OMEGA15 t))) - | F_left => - (apply_right (fusion trace') (Tplus_assoc_r t)) - | F_right => - (apply_right (fusion trace') (T_OMEGA12 t)) - end +Definition fusion_right (trace:list t_fusion) (t:term) : term := + match trace with + | nil => reduce t (* Il faut mettre un compute *) + | step :: trace' => + match step with + | F_equal => apply_right (fusion trace') (T_OMEGA15 t) + | F_cancel => fusion trace' (Tred_factor5 (T_OMEGA15 t)) + | F_left => apply_right (fusion trace') (Tplus_assoc_r t) + | F_right => apply_right (fusion trace') (T_OMEGA12 t) + end end. (* \paragraph{Fusion avec anihilation} *) (* Normalement le résultat est une constante *) -Fixpoint fusion_cancel [trace:nat] : term -> term := [t:term] - Cases trace of - O => (reduce t) - | (S trace') => (fusion_cancel trace' (T_OMEGA13 t)) +Fixpoint fusion_cancel (trace:nat) (t:term) {struct trace} : term := + match trace with + | O => reduce t + | S trace' => fusion_cancel trace' (T_OMEGA13 t) end. -Theorem fusion_cancel_stable : (t:nat) (term_stable (fusion_cancel t)). +Theorem fusion_cancel_stable : forall t:nat, term_stable (fusion_cancel t). -Unfold term_stable fusion_cancel; Intros trace e; Elim trace; [ - Exact (reduce_stable e) -| Intros n H t; Elim H; Exact (T_OMEGA13_stable e t) ]. -Save. +unfold term_stable, fusion_cancel in |- *; intros trace e; elim trace; + [ exact (reduce_stable e) + | intros n H t; elim H; exact (T_OMEGA13_stable e t) ]. +Qed. (* \subsubsection{Opérations afines sur une équation} *) (* \paragraph{Multiplication scalaire et somme d'une constante} *) -Fixpoint scalar_norm_add [trace:nat] : term -> term := [t: term] - Cases trace of - O => (reduce t) - | (S trace') => (apply_right (scalar_norm_add trace') (T_OMEGA11 t)) +Fixpoint scalar_norm_add (trace:nat) (t:term) {struct trace} : term := + match trace with + | O => reduce t + | S trace' => apply_right (scalar_norm_add trace') (T_OMEGA11 t) end. -Theorem scalar_norm_add_stable : (t:nat) (term_stable (scalar_norm_add t)). +Theorem scalar_norm_add_stable : + forall t:nat, term_stable (scalar_norm_add t). -Unfold term_stable scalar_norm_add; Intros trace; Elim trace; [ - Exact reduce_stable -| Intros n H e t; Elim apply_right_stable; - [ Exact (T_OMEGA11_stable e t) | Exact H ]]. -Save. +unfold term_stable, scalar_norm_add in |- *; intros trace; elim trace; + [ exact reduce_stable + | intros n H e t; elim apply_right_stable; + [ exact (T_OMEGA11_stable e t) | exact H ] ]. +Qed. (* \paragraph{Multiplication scalaire} *) -Fixpoint scalar_norm [trace:nat] : term -> term := [t: term] - Cases trace of - O => (reduce t) - | (S trace') => (apply_right (scalar_norm trace') (T_OMEGA16 t)) +Fixpoint scalar_norm (trace:nat) (t:term) {struct trace} : term := + match trace with + | O => reduce t + | S trace' => apply_right (scalar_norm trace') (T_OMEGA16 t) end. -Theorem scalar_norm_stable : (t:nat) (term_stable (scalar_norm t)). +Theorem scalar_norm_stable : forall t:nat, term_stable (scalar_norm t). -Unfold term_stable scalar_norm; Intros trace; Elim trace; [ - Exact reduce_stable -| Intros n H e t; Elim apply_right_stable; - [ Exact (T_OMEGA16_stable e t) | Exact H ]]. -Save. +unfold term_stable, scalar_norm in |- *; intros trace; elim trace; + [ exact reduce_stable + | intros n H e t; elim apply_right_stable; + [ exact (T_OMEGA16_stable e t) | exact H ] ]. +Qed. (* \paragraph{Somme d'une constante} *) -Fixpoint add_norm [trace:nat] : term -> term := [t: term] - Cases trace of - O => (reduce t) - | (S trace') => (apply_right (add_norm trace') (Tplus_assoc_r t)) +Fixpoint add_norm (trace:nat) (t:term) {struct trace} : term := + match trace with + | O => reduce t + | S trace' => apply_right (add_norm trace') (Tplus_assoc_r t) end. -Theorem add_norm_stable : (t:nat) (term_stable (add_norm t)). +Theorem add_norm_stable : forall t:nat, term_stable (add_norm t). -Unfold term_stable add_norm; Intros trace; Elim trace; [ - Exact reduce_stable -| Intros n H e t; Elim apply_right_stable; - [ Exact (Tplus_assoc_r_stable e t) | Exact H ]]. -Save. +unfold term_stable, add_norm in |- *; intros trace; elim trace; + [ exact reduce_stable + | intros n H e t; elim apply_right_stable; + [ exact (Tplus_assoc_r_stable e t) | exact H ] ]. +Qed. (* \subsection{La fonction de normalisation des termes (moteur de réécriture)} *) -Inductive step : Set := - | C_DO_BOTH : step -> step -> step - | C_LEFT : step -> step - | C_RIGHT : step -> step - | C_SEQ : step -> step -> step - | C_NOP : step - | C_OPP_PLUS : step - | C_OPP_OPP : step - | C_OPP_MULT_R : step - | C_OPP_ONE : step - | C_REDUCE : step - | C_MULT_PLUS_DISTR : step - | C_MULT_OPP_LEFT : step - | C_MULT_ASSOC_R : step - | C_PLUS_ASSOC_R : step - | C_PLUS_ASSOC_L : step - | C_PLUS_PERMUTE : step - | C_PLUS_SYM : step - | C_RED0 : step - | C_RED1 : step - | C_RED2 : step - | C_RED3 : step - | C_RED4 : step - | C_RED5 : step - | C_RED6 : step - | C_MULT_ASSOC_REDUCED : step - | C_MINUS :step - | C_MULT_SYM : step -. - -Fixpoint rewrite [s: step] : term -> term := - Cases s of - | (C_DO_BOTH s1 s2) => (apply_both (rewrite s1) (rewrite s2)) - | (C_LEFT s) => (apply_left (rewrite s)) - | (C_RIGHT s) => (apply_right (rewrite s)) - | (C_SEQ s1 s2) => [t: term] (rewrite s2 (rewrite s1 t)) - | C_NOP => [t:term] t - | C_OPP_PLUS => Topp_plus - | C_OPP_OPP => Topp_opp - | C_OPP_MULT_R => Topp_mult_r - | C_OPP_ONE => Topp_one - | C_REDUCE => reduce - | C_MULT_PLUS_DISTR => Tmult_plus_distr - | C_MULT_OPP_LEFT => Tmult_opp_left - | C_MULT_ASSOC_R => Tmult_assoc_r - | C_PLUS_ASSOC_R => Tplus_assoc_r - | C_PLUS_ASSOC_L => Tplus_assoc_l - | C_PLUS_PERMUTE => Tplus_permute - | C_PLUS_SYM => Tplus_sym - | C_RED0 => Tred_factor0 - | C_RED1 => Tred_factor1 - | C_RED2 => Tred_factor2 - | C_RED3 => Tred_factor3 - | C_RED4 => Tred_factor4 - | C_RED5 => Tred_factor5 - | C_RED6 => Tred_factor6 - | C_MULT_ASSOC_REDUCED => Tmult_assoc_reduced - | C_MINUS => Tminus_def - | C_MULT_SYM => Tmult_sym +Inductive step : Set := + | C_DO_BOTH : step -> step -> step + | C_LEFT : step -> step + | C_RIGHT : step -> step + | C_SEQ : step -> step -> step + | C_NOP : step + | C_OPP_PLUS : step + | C_OPP_OPP : step + | C_OPP_MULT_R : step + | C_OPP_ONE : step + | C_REDUCE : step + | C_MULT_PLUS_DISTR : step + | C_MULT_OPP_LEFT : step + | C_MULT_ASSOC_R : step + | C_PLUS_ASSOC_R : step + | C_PLUS_ASSOC_L : step + | C_PLUS_PERMUTE : step + | C_PLUS_SYM : step + | C_RED0 : step + | C_RED1 : step + | C_RED2 : step + | C_RED3 : step + | C_RED4 : step + | C_RED5 : step + | C_RED6 : step + | C_MULT_ASSOC_REDUCED : step + | C_MINUS : step + | C_MULT_SYM : step. + +Fixpoint rewrite (s:step) : term -> term := + match s with + | C_DO_BOTH s1 s2 => apply_both (rewrite s1) (rewrite s2) + | C_LEFT s => apply_left (rewrite s) + | C_RIGHT s => apply_right (rewrite s) + | C_SEQ s1 s2 => fun t:term => rewrite s2 (rewrite s1 t) + | C_NOP => fun t:term => t + | C_OPP_PLUS => Topp_plus + | C_OPP_OPP => Topp_opp + | C_OPP_MULT_R => Topp_mult_r + | C_OPP_ONE => Topp_one + | C_REDUCE => reduce + | C_MULT_PLUS_DISTR => Tmult_plus_distr + | C_MULT_OPP_LEFT => Tmult_opp_left + | C_MULT_ASSOC_R => Tmult_assoc_r + | C_PLUS_ASSOC_R => Tplus_assoc_r + | C_PLUS_ASSOC_L => Tplus_assoc_l + | C_PLUS_PERMUTE => Tplus_permute + | C_PLUS_SYM => Tplus_sym + | C_RED0 => Tred_factor0 + | C_RED1 => Tred_factor1 + | C_RED2 => Tred_factor2 + | C_RED3 => Tred_factor3 + | C_RED4 => Tred_factor4 + | C_RED5 => Tred_factor5 + | C_RED6 => Tred_factor6 + | C_MULT_ASSOC_REDUCED => Tmult_assoc_reduced + | C_MINUS => Tminus_def + | C_MULT_SYM => Tmult_sym end. -Theorem rewrite_stable : (s:step) (term_stable (rewrite s)). - -Induction s; Simpl; [ - Intros; Apply apply_both_stable; Auto -| Intros; Apply apply_left_stable; Auto -| Intros; Apply apply_right_stable; Auto -| Unfold term_stable; Intros; Elim H0; Apply H -| Unfold term_stable; Auto -| Exact Topp_plus_stable -| Exact Topp_opp_stable -| Exact Topp_mult_r_stable -| Exact Topp_one_stable -| Exact reduce_stable -| Exact Tmult_plus_distr_stable -| Exact Tmult_opp_left_stable -| Exact Tmult_assoc_r_stable -| Exact Tplus_assoc_r_stable -| Exact Tplus_assoc_l_stable -| Exact Tplus_permute_stable -| Exact Tplus_sym_stable -| Exact Tred_factor0_stable -| Exact Tred_factor1_stable -| Exact Tred_factor2_stable -| Exact Tred_factor3_stable -| Exact Tred_factor4_stable -| Exact Tred_factor5_stable -| Exact Tred_factor6_stable -| Exact Tmult_assoc_reduced_stable -| Exact Tminus_def_stable -| Exact Tmult_sym_stable ]. -Save. +Theorem rewrite_stable : forall s:step, term_stable (rewrite s). + +simple induction s; simpl in |- *; + [ intros; apply apply_both_stable; auto + | intros; apply apply_left_stable; auto + | intros; apply apply_right_stable; auto + | unfold term_stable in |- *; intros; elim H0; apply H + | unfold term_stable in |- *; auto + | exact Topp_plus_stable + | exact Topp_opp_stable + | exact Topp_mult_r_stable + | exact Topp_one_stable + | exact reduce_stable + | exact Tmult_plus_distr_stable + | exact Tmult_opp_left_stable + | exact Tmult_assoc_r_stable + | exact Tplus_assoc_r_stable + | exact Tplus_assoc_l_stable + | exact Tplus_permute_stable + | exact Tplus_sym_stable + | exact Tred_factor0_stable + | exact Tred_factor1_stable + | exact Tred_factor2_stable + | exact Tred_factor3_stable + | exact Tred_factor4_stable + | exact Tred_factor5_stable + | exact Tred_factor6_stable + | exact Tmult_assoc_reduced_stable + | exact Tminus_def_stable + | exact Tmult_sym_stable ]. +Qed. (* \subsection{tactiques de résolution d'un but omega normalisé} Trace de la procédure \subsubsection{Tactiques générant une contradiction} \paragraph{[O_CONSTANT_NOT_NUL]} *) -Definition constant_not_nul [i:nat; h: hyps] := - Cases (nth_hyps i h) of - (EqTerm (Tint ZERO) (Tint n)) => - Case (eq_Z n ZERO) of - h - absurd - end - | _ => h +Definition constant_not_nul (i:nat) (h:hyps) := + match nth_hyps i h with + | EqTerm (Tint Z0) (Tint n) => + match eq_Z n 0 with + | true => h + | false => absurd + end + | _ => h end. -Theorem constant_not_nul_valid : - (i:nat) (valid_hyps (constant_not_nul i)). +Theorem constant_not_nul_valid : + forall i:nat, valid_hyps (constant_not_nul i). -Unfold valid_hyps constant_not_nul; Intros; -Generalize (nth_valid e i lp); Simplify; Simpl; (Elim_eq_Z z0 ZERO); Auto; -Simpl; Intros H1 H2; Elim H1; Symmetry; Auto. -Save. +unfold valid_hyps, constant_not_nul in |- *; intros; + generalize (nth_valid e i lp); Simplify; simpl in |- *; + elim_eq_Z z0 0%Z; auto; simpl in |- *; intros H1 H2; + elim H1; symmetry in |- *; auto. +Qed. (* \paragraph{[O_CONSTANT_NEG]} *) -Definition constant_neg [i:nat; h: hyps] := - Cases (nth_hyps i h) of - (LeqTerm (Tint ZERO) (Tint (NEG n))) => absurd - | _ => h - end. +Definition constant_neg (i:nat) (h:hyps) := + match nth_hyps i h with + | LeqTerm (Tint Z0) (Tint (Zneg n)) => absurd + | _ => h + end. -Theorem constant_neg_valid : (i:nat) (valid_hyps (constant_neg i)). +Theorem constant_neg_valid : forall i:nat, valid_hyps (constant_neg i). -Unfold valid_hyps constant_neg; Intros; -Generalize (nth_valid e i lp); Simplify; Simpl; Unfold Zle; Simpl; -Intros H1; Elim H1; [ Assumption | Trivial ]. -Save. +unfold valid_hyps, constant_neg in |- *; intros; + generalize (nth_valid e i lp); Simplify; simpl in |- *; + unfold Zle in |- *; simpl in |- *; intros H1; elim H1; + [ assumption | trivial ]. +Qed. (* \paragraph{[NOT_EXACT_DIVIDE]} *) -Definition not_exact_divide [k1,k2:Z; body:term; t:nat; i : nat; l:hyps] := - Cases (nth_hyps i l) of - (EqTerm (Tint ZERO) b) => - Case (eq_term - (scalar_norm_add t (Tplus (Tmult body (Tint k1)) (Tint k2))) b) of - Cases (Zcompare k2 ZERO) of - SUPERIEUR => - Cases (Zcompare k1 k2) of - SUPERIEUR => absurd - | _ => l - end - | _ => l - end - l - end - | _ => l - end. +Definition not_exact_divide (k1 k2:Z) (body:term) (t i:nat) + (l:hyps) := + match nth_hyps i l with + | EqTerm (Tint Z0) b => + match + eq_term (scalar_norm_add t (Tplus (Tmult body (Tint k1)) (Tint k2))) + b + with + | true => + match (k2 ?= 0)%Z with + | Datatypes.Gt => + match (k1 ?= k2)%Z with + | Datatypes.Gt => absurd + | _ => l + end + | _ => l + end + | false => l + end + | _ => l + end. -Theorem not_exact_divide_valid : (k1,k2:Z; body:term; t:nat; i:nat) - (valid_hyps (not_exact_divide k1 k2 body t i)). +Theorem not_exact_divide_valid : + forall (k1 k2:Z) (body:term) (t i:nat), + valid_hyps (not_exact_divide k1 k2 body t i). -Unfold valid_hyps not_exact_divide; Intros; Generalize (nth_valid e i lp); -Simplify; -(Elim_eq_term '(scalar_norm_add t (Tplus (Tmult body (Tint k1)) (Tint k2))) - 't1); Auto; -Simplify; -Intro H2; Elim H2; Simpl; Elim (scalar_norm_add_stable t e); Simpl; -Intro H4; Absurd `(interp_term e body)*k1+k2 = 0`; [ - Apply OMEGA4; Assumption | Symmetry; Auto ]. +unfold valid_hyps, not_exact_divide in |- *; intros; + generalize (nth_valid e i lp); Simplify; + elim_eq_term (scalar_norm_add t (Tplus (Tmult body (Tint k1)) (Tint k2))) t1; + auto; Simplify; intro H2; elim H2; simpl in |- *; + elim (scalar_norm_add_stable t e); simpl in |- *; + intro H4; absurd ((interp_term e body * k1 + k2)%Z = 0%Z); + [ apply OMEGA4; assumption | symmetry in |- *; auto ]. -Save. +Qed. (* \paragraph{[O_CONTRADICTION]} *) -Definition contradiction [t: nat; i,j:nat;l:hyps] := - Cases (nth_hyps i l) of - (LeqTerm (Tint ZERO) b1) => - Cases (nth_hyps j l) of - (LeqTerm (Tint ZERO) b2) => - Cases (fusion_cancel t (Tplus b1 b2)) of - (Tint k) => - Cases (Zcompare ZERO k) of - SUPERIEUR => absurd - | _ => l - end - | _ => l - end - | _ => l - end - | _ => l +Definition contradiction (t i j:nat) (l:hyps) := + match nth_hyps i l with + | LeqTerm (Tint Z0) b1 => + match nth_hyps j l with + | LeqTerm (Tint Z0) b2 => + match fusion_cancel t (Tplus b1 b2) with + | Tint k => + match (0 ?= k)%Z with + | Datatypes.Gt => absurd + | _ => l + end + | _ => l + end + | _ => l + end + | _ => l end. -Theorem contradiction_valid : (t,i,j: nat) (valid_hyps (contradiction t i j)). - -Unfold valid_hyps contradiction; Intros t i j e l H; -Generalize (nth_valid ? i ? H); Generalize (nth_valid ? j ? H); -Case (nth_hyps i l); Auto; Intros t1 t2; Case t1; Auto; Intros z; Case z; Auto; -Case (nth_hyps j l); Auto; Intros t3 t4; Case t3; Auto; Intros z'; Case z'; -Auto; Simpl; Intros H1 H2; -Generalize (refl_equal Z (interp_term e (fusion_cancel t (Tplus t2 t4)))); -Pattern 2 3 (fusion_cancel t (Tplus t2 t4)); -Case (fusion_cancel t (Tplus t2 t4)); -Simpl; Auto; Intro k; Elim (fusion_cancel_stable t); -Simpl; Intro E; Generalize (OMEGA2 ? ? H2 H1); Rewrite E; Case k; -Auto;Unfold Zle; Simpl; Intros p H3; Elim H3; Auto. - -Save. +Theorem contradiction_valid : + forall t i j:nat, valid_hyps (contradiction t i j). + +unfold valid_hyps, contradiction in |- *; intros t i j e l H; + generalize (nth_valid _ i _ H); generalize (nth_valid _ j _ H); + case (nth_hyps i l); auto; intros t1 t2; case t1; + auto; intros z; case z; auto; case (nth_hyps j l); + auto; intros t3 t4; case t3; auto; intros z'; case z'; + auto; simpl in |- *; intros H1 H2; + generalize (refl_equal (interp_term e (fusion_cancel t (Tplus t2 t4)))); + pattern (fusion_cancel t (Tplus t2 t4)) at 2 3 in |- *; + case (fusion_cancel t (Tplus t2 t4)); simpl in |- *; + auto; intro k; elim (fusion_cancel_stable t); simpl in |- *; + intro E; generalize (OMEGA2 _ _ H2 H1); rewrite E; + case k; auto; unfold Zle in |- *; simpl in |- *; intros p H3; + elim H3; auto. + +Qed. (* \paragraph{[O_NEGATE_CONTRADICT]} *) -Definition negate_contradict [i1,i2:nat; h:hyps]:= - Cases (nth_hyps i1 h) of - (EqTerm (Tint ZERO) b1) => - Cases (nth_hyps i2 h) of - (NeqTerm (Tint ZERO) b2) => - Cases (eq_term b1 b2) of - true => absurd - | false => h - end - | _ => h - end - | (NeqTerm (Tint ZERO) b1) => - Cases (nth_hyps i2 h) of - (EqTerm (Tint ZERO) b2) => - Cases (eq_term b1 b2) of - true => absurd - | false => h - end - | _ => h - end +Definition negate_contradict (i1 i2:nat) (h:hyps) := + match nth_hyps i1 h with + | EqTerm (Tint Z0) b1 => + match nth_hyps i2 h with + | NeqTerm (Tint Z0) b2 => + match eq_term b1 b2 with + | true => absurd + | false => h + end + | _ => h + end + | NeqTerm (Tint Z0) b1 => + match nth_hyps i2 h with + | EqTerm (Tint Z0) b2 => + match eq_term b1 b2 with + | true => absurd + | false => h + end + | _ => h + end | _ => h end. -Definition negate_contradict_inv [t:nat; i1,i2:nat; h:hyps]:= - Cases (nth_hyps i1 h) of - (EqTerm (Tint ZERO) b1) => - Cases (nth_hyps i2 h) of - (NeqTerm (Tint ZERO) b2) => - Cases (eq_term b1 (scalar_norm t (Tmult b2 (Tint `-1`)))) of - true => absurd - | false => h - end - | _ => h - end - | (NeqTerm (Tint ZERO) b1) => - Cases (nth_hyps i2 h) of - (EqTerm (Tint ZERO) b2) => - Cases (eq_term b1 (scalar_norm t (Tmult b2 (Tint `-1`)))) of - true => absurd - | false => h - end - | _ => h - end +Definition negate_contradict_inv (t i1 i2:nat) (h:hyps) := + match nth_hyps i1 h with + | EqTerm (Tint Z0) b1 => + match nth_hyps i2 h with + | NeqTerm (Tint Z0) b2 => + match eq_term b1 (scalar_norm t (Tmult b2 (Tint (-1)))) with + | true => absurd + | false => h + end + | _ => h + end + | NeqTerm (Tint Z0) b1 => + match nth_hyps i2 h with + | EqTerm (Tint Z0) b2 => + match eq_term b1 (scalar_norm t (Tmult b2 (Tint (-1)))) with + | true => absurd + | false => h + end + | _ => h + end | _ => h end. Theorem negate_contradict_valid : - (i,j:nat) (valid_hyps (negate_contradict i j)). + forall i j:nat, valid_hyps (negate_contradict i j). -Unfold valid_hyps negate_contradict; Intros i j e l H; -Generalize (nth_valid ? i ? H); Generalize (nth_valid ? j ? H); -Case (nth_hyps i l); Auto; Intros t1 t2; Case t1; Auto; Intros z; Case z; Auto; -Case (nth_hyps j l); Auto; Intros t3 t4; Case t3; Auto; Intros z'; Case z'; -Auto; Simpl; Intros H1 H2; [ - (Elim_eq_term t2 t4); Intro H3; [ Elim H1; Elim H3; Assumption | Assumption ] -| (Elim_eq_term t2 t4); Intro H3; - [ Elim H2; Rewrite H3; Assumption | Assumption ]]. +unfold valid_hyps, negate_contradict in |- *; intros i j e l H; + generalize (nth_valid _ i _ H); generalize (nth_valid _ j _ H); + case (nth_hyps i l); auto; intros t1 t2; case t1; + auto; intros z; case z; auto; case (nth_hyps j l); + auto; intros t3 t4; case t3; auto; intros z'; case z'; + auto; simpl in |- *; intros H1 H2; + [ elim_eq_term t2 t4; intro H3; + [ elim H1; elim H3; assumption | assumption ] + | elim_eq_term t2 t4; intro H3; + [ elim H2; rewrite H3; assumption | assumption ] ]. -Save. +Qed. Theorem negate_contradict_inv_valid : - (t,i,j:nat) (valid_hyps (negate_contradict_inv t i j)). - - -Unfold valid_hyps negate_contradict_inv; Intros t i j e l H; -Generalize (nth_valid ? i ? H); Generalize (nth_valid ? j ? H); -Case (nth_hyps i l); Auto; Intros t1 t2; Case t1; Auto; Intros z; Case z; Auto; -Case (nth_hyps j l); Auto; Intros t3 t4; Case t3; Auto; Intros z'; Case z'; -Auto; Simpl; Intros H1 H2; -(Pattern (eq_term t2 (scalar_norm t (Tmult t4 (Tint (NEG xH))))); Apply bool_ind2; Intro Aux; [ - Generalize (eq_term_true t2 (scalar_norm t (Tmult t4 (Tint (NEG xH)))) Aux); - Clear Aux -| Generalize (eq_term_false t2 (scalar_norm t (Tmult t4 (Tint (NEG xH)))) Aux); - Clear Aux ]); [ - Intro H3; Elim H1; Generalize H2; Rewrite H3; - Rewrite <- (scalar_norm_stable t e); Simpl; Elim (interp_term e t4) ; - Simpl; Auto; Intros p H4; Discriminate H4 - | Auto - | Intro H3; Elim H2; Rewrite H3; Elim (scalar_norm_stable t e); Simpl; - Elim H1; Simpl; Trivial - | Auto ]. - -Save. + forall t i j:nat, valid_hyps (negate_contradict_inv t i j). + + +unfold valid_hyps, negate_contradict_inv in |- *; intros t i j e l H; + generalize (nth_valid _ i _ H); generalize (nth_valid _ j _ H); + case (nth_hyps i l); auto; intros t1 t2; case t1; + auto; intros z; case z; auto; case (nth_hyps j l); + auto; intros t3 t4; case t3; auto; intros z'; case z'; + auto; simpl in |- *; intros H1 H2; + (pattern (eq_term t2 (scalar_norm t (Tmult t4 (Tint (-1))))) in |- *; + apply bool_ind2; intro Aux; + [ generalize (eq_term_true t2 (scalar_norm t (Tmult t4 (Tint (-1)))) Aux); + clear Aux + | generalize (eq_term_false t2 (scalar_norm t (Tmult t4 (Tint (-1)))) Aux); + clear Aux ]); + [ intro H3; elim H1; generalize H2; rewrite H3; + rewrite <- (scalar_norm_stable t e); simpl in |- *; + elim (interp_term e t4); simpl in |- *; auto; intros p H4; + discriminate H4 + | auto + | intro H3; elim H2; rewrite H3; elim (scalar_norm_stable t e); + simpl in |- *; elim H1; simpl in |- *; trivial + | auto ]. + +Qed. (* \subsubsection{Tactiques générant une nouvelle équation} *) @@ -1518,139 +1593,143 @@ Save. preuve un peu compliquée. On utilise quelques lemmes qui sont des généralisations des théorèmes utilisés par OMEGA. *) -Definition sum [k1,k2: Z; trace: (list t_fusion); prop1,prop2:proposition]:= - Cases prop1 of - (EqTerm (Tint ZERO) b1) => - Cases prop2 of - (EqTerm (Tint ZERO) b2) => - (EqTerm - (Tint ZERO) - (fusion trace - (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2))))) - | (LeqTerm (Tint ZERO) b2) => - Cases (Zcompare k2 ZERO) of - SUPERIEUR => - (LeqTerm - (Tint ZERO) - (fusion trace - (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2))))) - | _ => TrueTerm - end - | _ => TrueTerm - end - | (LeqTerm (Tint ZERO) b1) => - Cases (Zcompare k1 ZERO) of - SUPERIEUR => - Cases prop2 of - (EqTerm (Tint ZERO) b2) => - (LeqTerm - (Tint ZERO) - (fusion trace - (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2))))) - | (LeqTerm (Tint ZERO) b2) => - Cases (Zcompare k2 ZERO) of - SUPERIEUR => - (LeqTerm - (Tint ZERO) - (fusion trace - (Tplus (Tmult b1 (Tint k1)) - (Tmult b2 (Tint k2))))) - | _ => TrueTerm - end - | _ => TrueTerm - end - | _ => TrueTerm - end - | (NeqTerm (Tint ZERO) b1) => - Cases prop2 of - (EqTerm (Tint ZERO) b2) => - Case (eq_Z k1 ZERO) of - TrueTerm - (NeqTerm - (Tint ZERO) - (fusion trace - (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2))))) - end +Definition sum (k1 k2:Z) (trace:list t_fusion) (prop1 prop2:proposition) := + match prop1 with + | EqTerm (Tint Z0) b1 => + match prop2 with + | EqTerm (Tint Z0) b2 => + EqTerm (Tint 0) + (fusion trace (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2)))) + | LeqTerm (Tint Z0) b2 => + match (k2 ?= 0)%Z with + | Datatypes.Gt => + LeqTerm (Tint 0) + (fusion trace + (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2)))) + | _ => TrueTerm + end + | _ => TrueTerm + end + | LeqTerm (Tint Z0) b1 => + match (k1 ?= 0)%Z with + | Datatypes.Gt => + match prop2 with + | EqTerm (Tint Z0) b2 => + LeqTerm (Tint 0) + (fusion trace + (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2)))) + | LeqTerm (Tint Z0) b2 => + match (k2 ?= 0)%Z with + | Datatypes.Gt => + LeqTerm (Tint 0) + (fusion trace + (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2)))) + | _ => TrueTerm + end + | _ => TrueTerm + end + | _ => TrueTerm + end + | NeqTerm (Tint Z0) b1 => + match prop2 with + | EqTerm (Tint Z0) b2 => + match eq_Z k1 0 with + | true => TrueTerm + | false => + NeqTerm (Tint 0) + (fusion trace + (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2)))) + end | _ => TrueTerm end | _ => TrueTerm end. Theorem sum1 : - (a,b,c,d:Z) (`0 = a`) -> (`0 = b`) -> (`0 = a*c + b*d`). + forall a b c d:Z, 0%Z = a -> 0%Z = b -> 0%Z = (a * c + b * d)%Z. -Intros; Elim H; Elim H0; Simpl; Auto. -Save. +intros; elim H; elim H0; simpl in |- *; auto. +Qed. Theorem sum2 : - (a,b,c,d:Z) (`0 <= d`) -> (`0 = a`) -> (`0 <= b`) ->(`0 <= a*c + b*d`). + forall a b c d:Z, + (0 <= d)%Z -> 0%Z = a -> (0 <= b)%Z -> (0 <= a * c + b * d)%Z. -Intros; Elim H0; Simpl; Generalize H H1; Case b; Case d; -Unfold Zle; Simpl; Auto. -Save. +intros; elim H0; simpl in |- *; generalize H H1; case b; case d; + unfold Zle in |- *; simpl in |- *; auto. +Qed. Theorem sum3 : - (a,b,c,d:Z) (`0 <= c`) -> (`0 <= d`) -> (`0 <= a`) -> (`0 <= b`) ->(`0 <= a*c + b*d`). + forall a b c d:Z, + (0 <= c)%Z -> + (0 <= d)%Z -> (0 <= a)%Z -> (0 <= b)%Z -> (0 <= a * c + b * d)%Z. -Intros a b c d; Case a; Case b; Case c; Case d; Unfold Zle; Simpl; Auto. -Save. +intros a b c d; case a; case b; case c; case d; unfold Zle in |- *; + simpl in |- *; auto. +Qed. -Theorem sum4 : (k:Z) (Zcompare k `0`)=SUPERIEUR -> (`0 <= k`). +Theorem sum4 : forall k:Z, (k ?= 0)%Z = Datatypes.Gt -> (0 <= k)%Z. -Intro; Case k; Unfold Zle; Simpl; Auto; Intros; Discriminate. -Save. +intro; case k; unfold Zle in |- *; simpl in |- *; auto; intros; discriminate. +Qed. Theorem sum5 : - (a,b,c,d:Z) (`c <> 0`) -> (`0 <> a`) -> (`0 = b`) -> (`0 <> a*c + b*d`). + forall a b c d:Z, + c <> 0%Z -> 0%Z <> a -> 0%Z = b -> 0%Z <> (a * c + b * d)%Z. -Intros a b c d H1 H2 H3; Elim H3; Simpl; Rewrite Zplus_sym; -Simpl; Generalize H1 H2; Case a; Case c; Simpl; Intros; Try Discriminate; -Assumption. -Save. +intros a b c d H1 H2 H3; elim H3; simpl in |- *; rewrite Zplus_comm; + simpl in |- *; generalize H1 H2; case a; case c; simpl in |- *; + intros; try discriminate; assumption. +Qed. -Theorem sum_valid : (k1,k2:Z; t:(list t_fusion)) (valid2 (sum k1 k2 t)). +Theorem sum_valid : forall (k1 k2:Z) (t:list t_fusion), valid2 (sum k1 k2 t). -Unfold valid2; Intros k1 k2 t e p1 p2; Unfold sum; Simplify; Simpl; Auto; -Try (Elim (fusion_stable t)); Simpl; Intros; [ - Apply sum1; Assumption -| Apply sum2; Try Assumption; Apply sum4; Assumption -| Rewrite Zplus_sym; Apply sum2; Try Assumption; Apply sum4; Assumption -| Apply sum3; Try Assumption; Apply sum4; Assumption -| (Elim_eq_Z k1 ZERO); Simpl; Auto; Elim (fusion_stable t); Simpl; Intros; - Unfold Zne; Apply sum5; Assumption]. -Save. +unfold valid2 in |- *; intros k1 k2 t e p1 p2; unfold sum in |- *; Simplify; + simpl in |- *; auto; try elim (fusion_stable t); simpl in |- *; + intros; + [ apply sum1; assumption + | apply sum2; try assumption; apply sum4; assumption + | rewrite Zplus_comm; apply sum2; try assumption; apply sum4; assumption + | apply sum3; try assumption; apply sum4; assumption + | elim_eq_Z k1 0%Z; simpl in |- *; auto; elim (fusion_stable t); + simpl in |- *; intros; unfold Zne in |- *; apply sum5; + assumption ]. +Qed. (* \paragraph{[O_EXACT_DIVIDE]} c'est une oper1 valide mais on préfère une substitution a ce point la *) -Definition exact_divide [k:Z; body:term; t: nat; prop:proposition] := - Cases prop of - (EqTerm (Tint ZERO) b) => - Case (eq_term (scalar_norm t (Tmult body (Tint k))) b) of - Case (eq_Z k ZERO) of - TrueTerm - (EqTerm (Tint ZERO) body) - end - TrueTerm - end - | _ => TrueTerm - end. +Definition exact_divide (k:Z) (body:term) (t:nat) (prop:proposition) := + match prop with + | EqTerm (Tint Z0) b => + match eq_term (scalar_norm t (Tmult body (Tint k))) b with + | true => + match eq_Z k 0 with + | true => TrueTerm + | false => EqTerm (Tint 0) body + end + | false => TrueTerm + end + | _ => TrueTerm + end. Theorem exact_divide_valid : - (k:Z) (t:term) (n:nat) (valid1 (exact_divide k t n)). + forall (k:Z) (t:term) (n:nat), valid1 (exact_divide k t n). -Unfold valid1 exact_divide; Intros k1 k2 t e p1; Simplify;Simpl; Auto; -(Elim_eq_term '(scalar_norm t (Tmult k2 (Tint k1))) 't1); Simpl; Auto; -(Elim_eq_Z 'k1 '(ZERO)); Simpl; Auto; Intros H1 H2; Elim H2; -Elim scalar_norm_stable; Simpl; Generalize H1; Case (interp_term e k2); -Try Trivial; (Case k1; Simpl; [ - Intros; Absurd `0 = 0`; Assumption -| Intros p2 p3 H3 H4; Discriminate H4 -| Intros p2 p3 H3 H4; Discriminate H4 ]). +unfold valid1, exact_divide in |- *; intros k1 k2 t e p1; Simplify; + simpl in |- *; auto; elim_eq_term (scalar_norm t (Tmult k2 (Tint k1))) t1; + simpl in |- *; auto; elim_eq_Z k1 0%Z; simpl in |- *; + auto; intros H1 H2; elim H2; elim scalar_norm_stable; + simpl in |- *; generalize H1; case (interp_term e k2); + try trivial; + (case k1; simpl in |- *; + [ intros; absurd (0%Z = 0%Z); assumption + | intros p2 p3 H3 H4; discriminate H4 + | intros p2 p3 H3 H4; discriminate H4 ]). -Save. +Qed. @@ -1658,302 +1737,327 @@ Save. La preuve reprend le schéma de la précédente mais on est sur une opération de type valid1 et non sur une opération terminale. *) -Definition divide_and_approx [k1,k2:Z; body:term; t:nat; prop:proposition] := - Cases prop of - (LeqTerm (Tint ZERO) b) => - Case (eq_term - (scalar_norm_add t (Tplus (Tmult body (Tint k1)) (Tint k2))) b) of - Cases (Zcompare k1 ZERO) of - SUPERIEUR => - Cases (Zcompare k1 k2) of - SUPERIEUR =>(LeqTerm (Tint ZERO) body) - | _ => prop - end - | _ => prop - end - prop - end - | _ => prop - end. +Definition divide_and_approx (k1 k2:Z) (body:term) + (t:nat) (prop:proposition) := + match prop with + | LeqTerm (Tint Z0) b => + match + eq_term (scalar_norm_add t (Tplus (Tmult body (Tint k1)) (Tint k2))) + b + with + | true => + match (k1 ?= 0)%Z with + | Datatypes.Gt => + match (k1 ?= k2)%Z with + | Datatypes.Gt => LeqTerm (Tint 0) body + | _ => prop + end + | _ => prop + end + | false => prop + end + | _ => prop + end. -Theorem divide_and_approx_valid : (k1,k2:Z; body:term; t:nat) - (valid1 (divide_and_approx k1 k2 body t)). +Theorem divide_and_approx_valid : + forall (k1 k2:Z) (body:term) (t:nat), + valid1 (divide_and_approx k1 k2 body t). -Unfold valid1 divide_and_approx; Intros k1 k2 body t e p1;Simplify; -(Elim_eq_term '(scalar_norm_add t (Tplus (Tmult body (Tint k1)) (Tint k2))) 't1); Simplify; Auto; Intro E; Elim E; Simpl; -Elim (scalar_norm_add_stable t e); Simpl; Intro H1; -Apply Zmult_le_approx with 3 := H1; Assumption. -Save. +unfold valid1, divide_and_approx in |- *; intros k1 k2 body t e p1; Simplify; + elim_eq_term (scalar_norm_add t (Tplus (Tmult body (Tint k1)) (Tint k2))) t1; + Simplify; auto; intro E; elim E; simpl in |- *; + elim (scalar_norm_add_stable t e); simpl in |- *; + intro H1; apply Zmult_le_approx with (3 := H1); assumption. +Qed. (* \paragraph{[MERGE_EQ]} *) -Definition merge_eq [t: nat; prop1, prop2: proposition] := - Cases prop1 of - (LeqTerm (Tint ZERO) b1) => - Cases prop2 of - (LeqTerm (Tint ZERO) b2) => - Case (eq_term b1 (scalar_norm t (Tmult b2 (Tint `-1`)))) of - (EqTerm (Tint ZERO) b1) - TrueTerm - end - | _ => TrueTerm - end +Definition merge_eq (t:nat) (prop1 prop2:proposition) := + match prop1 with + | LeqTerm (Tint Z0) b1 => + match prop2 with + | LeqTerm (Tint Z0) b2 => + match eq_term b1 (scalar_norm t (Tmult b2 (Tint (-1)))) with + | true => EqTerm (Tint 0) b1 + | false => TrueTerm + end + | _ => TrueTerm + end | _ => TrueTerm end. -Theorem merge_eq_valid : (n:nat) (valid2 (merge_eq n)). +Theorem merge_eq_valid : forall n:nat, valid2 (merge_eq n). -Unfold valid2 merge_eq; Intros n e p1 p2; Simplify; Simpl; Auto; -Elim (scalar_norm_stable n e); Simpl; Intros; Symmetry; -Apply OMEGA8 with 2 := H0; [ Assumption | Elim Zopp_one; Trivial ]. -Save. +unfold valid2, merge_eq in |- *; intros n e p1 p2; Simplify; simpl in |- *; + auto; elim (scalar_norm_stable n e); simpl in |- *; + intros; symmetry in |- *; apply OMEGA8 with (2 := H0); + [ assumption | elim Zopp_eq_mult_neg_1; trivial ]. +Qed. (* \paragraph{[O_CONSTANT_NUL]} *) -Definition constant_nul [i:nat; h: hyps] := - Cases (nth_hyps i h) of - (NeqTerm (Tint ZERO) (Tint ZERO)) => absurd - | _ => h +Definition constant_nul (i:nat) (h:hyps) := + match nth_hyps i h with + | NeqTerm (Tint Z0) (Tint Z0) => absurd + | _ => h end. -Theorem constant_nul_valid : - (i:nat) (valid_hyps (constant_nul i)). +Theorem constant_nul_valid : forall i:nat, valid_hyps (constant_nul i). -Unfold valid_hyps constant_nul; Intros; Generalize (nth_valid e i lp); -Simplify; Simpl; Unfold Zne; Intro H1; Absurd `0=0`; Auto. -Save. +unfold valid_hyps, constant_nul in |- *; intros; + generalize (nth_valid e i lp); Simplify; simpl in |- *; + unfold Zne in |- *; intro H1; absurd (0%Z = 0%Z); + auto. +Qed. (* \paragraph{[O_STATE]} *) -Definition state [m:Z;s:step; prop1,prop2:proposition] := - Cases prop1 of - (EqTerm (Tint ZERO) b1) => - Cases prop2 of - (EqTerm (Tint ZERO) (Tplus b2 (Topp b3))) => - (EqTerm (Tint ZERO) (rewrite s (Tplus b1 (Tmult (Tplus (Topp b3) b2) (Tint m))))) - | _ => TrueTerm - end +Definition state (m:Z) (s:step) (prop1 prop2:proposition) := + match prop1 with + | EqTerm (Tint Z0) b1 => + match prop2 with + | EqTerm (Tint Z0) (Tplus b2 (Topp b3)) => + EqTerm (Tint 0) + (rewrite s (Tplus b1 (Tmult (Tplus (Topp b3) b2) (Tint m)))) + | _ => TrueTerm + end | _ => TrueTerm end. -Theorem state_valid : (m:Z; s:step) (valid2 (state m s)). +Theorem state_valid : forall (m:Z) (s:step), valid2 (state m s). -Unfold valid2; Intros m s e p1 p2; Unfold state; Simplify; Simpl;Auto; -Elim (rewrite_stable s e); Simpl; Intros H1 H2; Elim H1; -Rewrite (Zplus_sym `-(interp_term e t5)` `(interp_term e t3)`); -Elim H2; Simpl; Reflexivity. +unfold valid2 in |- *; intros m s e p1 p2; unfold state in |- *; Simplify; + simpl in |- *; auto; elim (rewrite_stable s e); simpl in |- *; + intros H1 H2; elim H1; + rewrite (Zplus_comm (- interp_term e t5) (interp_term e t3)); + elim H2; simpl in |- *; reflexivity. -Save. +Qed. (* \subsubsection{Tactiques générant plusieurs but} \paragraph{[O_SPLIT_INEQ]} La seule pour le moment (tant que la normalisation n'est pas réfléchie). *) -Definition split_ineq [i,t: nat; f1,f2:hyps -> lhyps; l:hyps] := - Cases (nth_hyps i l) of - (NeqTerm (Tint ZERO) b1) => - (app (f1 (cons (LeqTerm (Tint ZERO) (add_norm t (Tplus b1 (Tint `-1`)))) l)) - (f2 (cons (LeqTerm (Tint ZERO) - (scalar_norm_add t - (Tplus (Tmult b1 (Tint `-1`)) (Tint `-1`)))) - l))) - | _ => (cons l (nil ?)) +Definition split_ineq (i t:nat) (f1 f2:hyps -> lhyps) + (l:hyps) := + match nth_hyps i l with + | NeqTerm (Tint Z0) b1 => + f1 (LeqTerm (Tint 0) (add_norm t (Tplus b1 (Tint (-1)))) :: l) ++ + f2 + (LeqTerm (Tint 0) + (scalar_norm_add t (Tplus (Tmult b1 (Tint (-1))) (Tint (-1)))) + :: l) + | _ => l :: nil end. -Theorem split_ineq_valid : - (i,t: nat; f1,f2: hyps -> lhyps) - (valid_list_hyps f1) ->(valid_list_hyps f2) -> - (valid_list_hyps (split_ineq i t f1 f2)). - -Unfold valid_list_hyps split_ineq; Intros i t f1 f2 H1 H2 e lp H; -Generalize (nth_valid ? i ? H); -Case (nth_hyps i lp); Simpl; Auto; Intros t1 t2; Case t1; Simpl; Auto; -Intros z; Case z; Simpl; Auto; -Intro H3; Apply append_valid;Elim (OMEGA19 (interp_term e t2)) ;[ - Intro H4; Left; Apply H1; Simpl; Elim (add_norm_stable t); Simpl; Auto -| Intro H4; Right; Apply H2; Simpl; Elim (scalar_norm_add_stable t); - Simpl; Auto -| Generalize H3; Unfold Zne not; Intros E1 E2; Apply E1; Symmetry; Trivial ]. -Save. +Theorem split_ineq_valid : + forall (i t:nat) (f1 f2:hyps -> lhyps), + valid_list_hyps f1 -> + valid_list_hyps f2 -> valid_list_hyps (split_ineq i t f1 f2). + +unfold valid_list_hyps, split_ineq in |- *; intros i t f1 f2 H1 H2 e lp H; + generalize (nth_valid _ i _ H); case (nth_hyps i lp); + simpl in |- *; auto; intros t1 t2; case t1; simpl in |- *; + auto; intros z; case z; simpl in |- *; auto; intro H3; + apply append_valid; elim (OMEGA19 (interp_term e t2)); + [ intro H4; left; apply H1; simpl in |- *; elim (add_norm_stable t); + simpl in |- *; auto + | intro H4; right; apply H2; simpl in |- *; elim (scalar_norm_add_stable t); + simpl in |- *; auto + | generalize H3; unfold Zne, not in |- *; intros E1 E2; apply E1; + symmetry in |- *; trivial ]. +Qed. (* \subsection{La fonction de rejeu de la trace} *) Inductive t_omega : Set := - (* n = 0 n!= 0 *) - | O_CONSTANT_NOT_NUL : nat -> t_omega - | O_CONSTANT_NEG : nat -> t_omega - (* division et approximation d'une équation *) - | O_DIV_APPROX : Z -> Z -> term -> nat -> t_omega -> nat -> t_omega - (* pas de solution car pas de division exacte (fin) *) - | O_NOT_EXACT_DIVIDE : Z -> Z -> term -> nat -> nat -> t_omega - (* division exacte *) - | O_EXACT_DIVIDE : Z -> term -> nat -> t_omega -> nat -> t_omega - | O_SUM : Z -> nat -> Z -> nat -> (list t_fusion) -> t_omega -> t_omega - | O_CONTRADICTION : nat -> nat -> nat -> t_omega - | O_MERGE_EQ : nat -> nat -> nat -> t_omega -> t_omega - | O_SPLIT_INEQ : nat -> nat -> t_omega -> t_omega -> t_omega - | O_CONSTANT_NUL : nat -> t_omega - | O_NEGATE_CONTRADICT : nat -> nat -> t_omega - | O_NEGATE_CONTRADICT_INV : nat -> nat -> nat -> t_omega - | O_STATE : Z -> step -> nat -> nat -> t_omega -> t_omega. - -Notation singleton := [a: hyps] (cons a (nil hyps)). - -Fixpoint execute_omega [t: t_omega] : hyps -> lhyps := - [l : hyps] Cases t of - | (O_CONSTANT_NOT_NUL n) => (singleton (constant_not_nul n l)) - | (O_CONSTANT_NEG n) => (singleton (constant_neg n l)) - | (O_DIV_APPROX k1 k2 body t cont n) => - (execute_omega cont - (apply_oper_1 n (divide_and_approx k1 k2 body t) l)) - | (O_NOT_EXACT_DIVIDE k1 k2 body t i) => - (singleton (not_exact_divide k1 k2 body t i l)) - | (O_EXACT_DIVIDE k body t cont n) => - (execute_omega cont (apply_oper_1 n (exact_divide k body t) l)) - | (O_SUM k1 i1 k2 i2 t cont) => - (execute_omega cont (apply_oper_2 i1 i2 (sum k1 k2 t) l)) - | (O_CONTRADICTION t i j) => - (singleton (contradiction t i j l)) - | (O_MERGE_EQ t i1 i2 cont) => - (execute_omega cont (apply_oper_2 i1 i2 (merge_eq t) l)) - | (O_SPLIT_INEQ t i cont1 cont2) => - (split_ineq i t (execute_omega cont1) (execute_omega cont2) l) - | (O_CONSTANT_NUL i) => (singleton (constant_nul i l)) - | (O_NEGATE_CONTRADICT i j) => (singleton (negate_contradict i j l)) - | (O_NEGATE_CONTRADICT_INV t i j) => (singleton (negate_contradict_inv t i j l)) - | (O_STATE m s i1 i2 cont) => - (execute_omega cont (apply_oper_2 i1 i2 (state m s) l)) + | O_CONSTANT_NOT_NUL : + (* n = 0 n!= 0 *) + nat -> t_omega + | O_CONSTANT_NEG : + nat -> t_omega + (* division et approximation d'une équation *) + | O_DIV_APPROX : + Z -> + Z -> + term -> + nat -> + t_omega -> + nat -> t_omega + (* pas de solution car pas de division exacte (fin) *) + | O_NOT_EXACT_DIVIDE : + Z -> Z -> term -> nat -> nat -> t_omega + (* division exacte *) + | O_EXACT_DIVIDE : Z -> term -> nat -> t_omega -> nat -> t_omega + | O_SUM : Z -> nat -> Z -> nat -> list t_fusion -> t_omega -> t_omega + | O_CONTRADICTION : nat -> nat -> nat -> t_omega + | O_MERGE_EQ : nat -> nat -> nat -> t_omega -> t_omega + | O_SPLIT_INEQ : nat -> nat -> t_omega -> t_omega -> t_omega + | O_CONSTANT_NUL : nat -> t_omega + | O_NEGATE_CONTRADICT : nat -> nat -> t_omega + | O_NEGATE_CONTRADICT_INV : nat -> nat -> nat -> t_omega + | O_STATE : Z -> step -> nat -> nat -> t_omega -> t_omega. + +Notation singleton := (fun a:hyps => a :: nil). + +Fixpoint execute_omega (t:t_omega) (l:hyps) {struct t} : lhyps := + match t with + | O_CONSTANT_NOT_NUL n => singleton (constant_not_nul n l) + | O_CONSTANT_NEG n => singleton (constant_neg n l) + | O_DIV_APPROX k1 k2 body t cont n => + execute_omega cont (apply_oper_1 n (divide_and_approx k1 k2 body t) l) + | O_NOT_EXACT_DIVIDE k1 k2 body t i => + singleton (not_exact_divide k1 k2 body t i l) + | O_EXACT_DIVIDE k body t cont n => + execute_omega cont (apply_oper_1 n (exact_divide k body t) l) + | O_SUM k1 i1 k2 i2 t cont => + execute_omega cont (apply_oper_2 i1 i2 (sum k1 k2 t) l) + | O_CONTRADICTION t i j => singleton (contradiction t i j l) + | O_MERGE_EQ t i1 i2 cont => + execute_omega cont (apply_oper_2 i1 i2 (merge_eq t) l) + | O_SPLIT_INEQ t i cont1 cont2 => + split_ineq i t (execute_omega cont1) (execute_omega cont2) l + | O_CONSTANT_NUL i => singleton (constant_nul i l) + | O_NEGATE_CONTRADICT i j => singleton (negate_contradict i j l) + | O_NEGATE_CONTRADICT_INV t i j => + singleton (negate_contradict_inv t i j l) + | O_STATE m s i1 i2 cont => + execute_omega cont (apply_oper_2 i1 i2 (state m s) l) end. -Theorem omega_valid : (t: t_omega) (valid_list_hyps (execute_omega t)). - -Induction t; Simpl; [ - Unfold valid_list_hyps; Simpl; Intros; Left; - Apply (constant_not_nul_valid n e lp H) -| Unfold valid_list_hyps; Simpl; Intros; Left; - Apply (constant_neg_valid n e lp H) -| Unfold valid_list_hyps valid_hyps; Intros k1 k2 body n t' Ht' m e lp H; - Apply Ht'; - Apply (apply_oper_1_valid m (divide_and_approx k1 k2 body n) - (divide_and_approx_valid k1 k2 body n) e lp H) -| Unfold valid_list_hyps; Simpl; Intros; Left; - Apply (not_exact_divide_valid z z0 t0 n n0 e lp H) -| Unfold valid_list_hyps valid_hyps; Intros k body n t' Ht' m e lp H; - Apply Ht'; - Apply (apply_oper_1_valid m (exact_divide k body n) - (exact_divide_valid k body n) e lp H) -| Unfold valid_list_hyps valid_hyps; Intros k1 i1 k2 i2 trace t' Ht' e lp H; - Apply Ht'; - Apply (apply_oper_2_valid i1 i2 (sum k1 k2 trace) - (sum_valid k1 k2 trace) e lp H) -| Unfold valid_list_hyps; Simpl; Intros; Left; - Apply (contradiction_valid n n0 n1 e lp H) -| Unfold valid_list_hyps valid_hyps; Intros trace i1 i2 t' Ht' e lp H; - Apply Ht'; - Apply (apply_oper_2_valid i1 i2 (merge_eq trace) - (merge_eq_valid trace) e lp H) -| Intros t' i k1 H1 k2 H2; Unfold valid_list_hyps; Simpl; Intros e lp H; - Apply (split_ineq_valid i t' (execute_omega k1) (execute_omega k2) - H1 H2 e lp H) -| Unfold valid_list_hyps; Simpl; Intros i e lp H; Left; - Apply (constant_nul_valid i e lp H) -| Unfold valid_list_hyps; Simpl; Intros i j e lp H; Left; - Apply (negate_contradict_valid i j e lp H) -| Unfold valid_list_hyps; Simpl; Intros n i j e lp H; Left; - Apply (negate_contradict_inv_valid n i j e lp H) -| Unfold valid_list_hyps valid_hyps; Intros m s i1 i2 t' Ht' e lp H; Apply Ht'; - Apply (apply_oper_2_valid i1 i2 (state m s) (state_valid m s) e lp H) -]. -Save. +Theorem omega_valid : forall t:t_omega, valid_list_hyps (execute_omega t). + +simple induction t; simpl in |- *; + [ unfold valid_list_hyps in |- *; simpl in |- *; intros; left; + apply (constant_not_nul_valid n e lp H) + | unfold valid_list_hyps in |- *; simpl in |- *; intros; left; + apply (constant_neg_valid n e lp H) + | unfold valid_list_hyps, valid_hyps in |- *; + intros k1 k2 body n t' Ht' m e lp H; apply Ht'; + apply + (apply_oper_1_valid m (divide_and_approx k1 k2 body n) + (divide_and_approx_valid k1 k2 body n) e lp H) + | unfold valid_list_hyps in |- *; simpl in |- *; intros; left; + apply (not_exact_divide_valid z z0 t0 n n0 e lp H) + | unfold valid_list_hyps, valid_hyps in |- *; + intros k body n t' Ht' m e lp H; apply Ht'; + apply + (apply_oper_1_valid m (exact_divide k body n) + (exact_divide_valid k body n) e lp H) + | unfold valid_list_hyps, valid_hyps in |- *; + intros k1 i1 k2 i2 trace t' Ht' e lp H; apply Ht'; + apply + (apply_oper_2_valid i1 i2 (sum k1 k2 trace) (sum_valid k1 k2 trace) e lp + H) + | unfold valid_list_hyps in |- *; simpl in |- *; intros; left; + apply (contradiction_valid n n0 n1 e lp H) + | unfold valid_list_hyps, valid_hyps in |- *; + intros trace i1 i2 t' Ht' e lp H; apply Ht'; + apply + (apply_oper_2_valid i1 i2 (merge_eq trace) (merge_eq_valid trace) e lp H) + | intros t' i k1 H1 k2 H2; unfold valid_list_hyps in |- *; simpl in |- *; + intros e lp H; + apply + (split_ineq_valid i t' (execute_omega k1) (execute_omega k2) H1 H2 e lp + H) + | unfold valid_list_hyps in |- *; simpl in |- *; intros i e lp H; left; + apply (constant_nul_valid i e lp H) + | unfold valid_list_hyps in |- *; simpl in |- *; intros i j e lp H; left; + apply (negate_contradict_valid i j e lp H) + | unfold valid_list_hyps in |- *; simpl in |- *; intros n i j e lp H; left; + apply (negate_contradict_inv_valid n i j e lp H) + | unfold valid_list_hyps, valid_hyps in |- *; intros m s i1 i2 t' Ht' e lp H; + apply Ht'; + apply (apply_oper_2_valid i1 i2 (state m s) (state_valid m s) e lp H) ]. +Qed. (* \subsection{Les opérations globales sur le but} \subsubsection{Normalisation} *) -Definition move_right [s: step; p:proposition] := - Cases p of - (EqTerm t1 t2) => (EqTerm (Tint ZERO) (rewrite s (Tplus t1 (Topp t2)))) - | (LeqTerm t1 t2) => (LeqTerm (Tint ZERO) (rewrite s (Tplus t2 (Topp t1)))) - | (GeqTerm t1 t2) => (LeqTerm (Tint ZERO) (rewrite s (Tplus t1 (Topp t2)))) - | (LtTerm t1 t2) => - (LeqTerm (Tint ZERO) - (rewrite s (Tplus (Tplus t2 (Tint `-1`)) (Topp t1)))) - | (GtTerm t1 t2) => - (LeqTerm (Tint ZERO) - (rewrite s (Tplus (Tplus t1 (Tint `-1`)) (Topp t2)))) - | (NeqTerm t1 t2) => (NeqTerm (Tint ZERO) (rewrite s (Tplus t1 (Topp t2)))) - | p => p +Definition move_right (s:step) (p:proposition) := + match p with + | EqTerm t1 t2 => EqTerm (Tint 0) (rewrite s (Tplus t1 (Topp t2))) + | LeqTerm t1 t2 => LeqTerm (Tint 0) (rewrite s (Tplus t2 (Topp t1))) + | GeqTerm t1 t2 => LeqTerm (Tint 0) (rewrite s (Tplus t1 (Topp t2))) + | LtTerm t1 t2 => + LeqTerm (Tint 0) (rewrite s (Tplus (Tplus t2 (Tint (-1))) (Topp t1))) + | GtTerm t1 t2 => + LeqTerm (Tint 0) (rewrite s (Tplus (Tplus t1 (Tint (-1))) (Topp t2))) + | NeqTerm t1 t2 => NeqTerm (Tint 0) (rewrite s (Tplus t1 (Topp t2))) + | p => p end. -Theorem Zne_left_2 : (x,y:Z)(Zne x y)->(Zne `0` `x+(-y)`). -Unfold Zne not; Intros x y H1 H2; Apply H1; Apply (Zsimpl_plus_l `-y`); -Rewrite Zplus_sym; Elim H2; Rewrite Zplus_inverse_l; Trivial. -Save. - -Theorem move_right_valid : (s: step) (valid1 (move_right s)). - -Unfold valid1 move_right; Intros s e p; Simplify; Simpl; -Elim (rewrite_stable s e); Simpl; [ - Symmetry; Apply Zegal_left; Assumption -| Intro; Apply Zle_left; Assumption -| Intro; Apply Zge_left; Assumption -| Intro; Apply Zgt_left; Assumption -| Intro; Apply Zlt_left; Assumption -| Intro; Apply Zne_left_2; Assumption -]. -Save. - -Definition do_normalize [i:nat; s: step] := (apply_oper_1 i (move_right s)). - -Theorem do_normalize_valid : (i:nat; s:step) (valid_hyps (do_normalize i s)). - -Intros; Unfold do_normalize; Apply apply_oper_1_valid; Apply move_right_valid. -Save. - -Fixpoint do_normalize_list [l:(list step)] : nat -> hyps -> hyps := - [i:nat; h:hyps] Cases l of - (cons s l') => (do_normalize_list l' (S i) (do_normalize i s h)) +Theorem Zne_left_2 : forall x y:Z, Zne x y -> Zne 0 (x + - y). +unfold Zne, not in |- *; intros x y H1 H2; apply H1; + apply (Zplus_reg_l (- y)); rewrite Zplus_comm; elim H2; + rewrite Zplus_opp_l; trivial. +Qed. + +Theorem move_right_valid : forall s:step, valid1 (move_right s). + +unfold valid1, move_right in |- *; intros s e p; Simplify; simpl in |- *; + elim (rewrite_stable s e); simpl in |- *; + [ symmetry in |- *; apply Zegal_left; assumption + | intro; apply Zle_left; assumption + | intro; apply Zge_left; assumption + | intro; apply Zgt_left; assumption + | intro; apply Zlt_left; assumption + | intro; apply Zne_left_2; assumption ]. +Qed. + +Definition do_normalize (i:nat) (s:step) := apply_oper_1 i (move_right s). + +Theorem do_normalize_valid : + forall (i:nat) (s:step), valid_hyps (do_normalize i s). + +intros; unfold do_normalize in |- *; apply apply_oper_1_valid; + apply move_right_valid. +Qed. + +Fixpoint do_normalize_list (l:list step) (i:nat) (h:hyps) {struct l} : + hyps := + match l with + | s :: l' => do_normalize_list l' (S i) (do_normalize i s h) | nil => h end. -Theorem do_normalize_list_valid : - (l:(list step); i:nat) (valid_hyps (do_normalize_list l i)). +Theorem do_normalize_list_valid : + forall (l:list step) (i:nat), valid_hyps (do_normalize_list l i). -Induction l; Simpl; Unfold valid_hyps; [ - Auto -| Intros a l' Hl' i e lp H; Unfold valid_hyps in Hl'; Apply Hl'; - Apply (do_normalize_valid i a e lp); Assumption ]. -Save. +simple induction l; simpl in |- *; unfold valid_hyps in |- *; + [ auto + | intros a l' Hl' i e lp H; unfold valid_hyps in Hl'; apply Hl'; + apply (do_normalize_valid i a e lp); assumption ]. +Qed. Theorem normalize_goal : - (s: (list step); env : (list Z); l: hyps) - (interp_goal env (do_normalize_list s O l)) -> - (interp_goal env l). + forall (s:list step) (env:list Z) (l:hyps), + interp_goal env (do_normalize_list s 0 l) -> interp_goal env l. -Intros; Apply valid_goal with 2:=H; Apply do_normalize_list_valid. -Save. +intros; apply valid_goal with (2 := H); apply do_normalize_list_valid. +Qed. (* \subsubsection{Exécution de la trace} *) Theorem execute_goal : - (t : t_omega; env : (list Z); l: hyps) - (interp_list_goal env (execute_omega t l)) -> (interp_goal env l). + forall (t:t_omega) (env:list Z) (l:hyps), + interp_list_goal env (execute_omega t l) -> interp_goal env l. -Intros; Apply (goal_valid (execute_omega t) (omega_valid t) env l H). -Save. +intros; apply (goal_valid (execute_omega t) (omega_valid t) env l H). +Qed. Theorem append_goal : - (e: (list Z)) (l1,l2:lhyps) - (interp_list_goal e l1) /\ (interp_list_goal e l2) -> - (interp_list_goal e (app l1 l2)). - -Intros e; Induction l1; [ - Simpl; Intros l2 (H1, H2); Assumption -| Simpl; Intros h1 t1 HR l2 ((H1 , H2), H3) ; Split; Auto]. + forall (e:list Z) (l1 l2:lhyps), + interp_list_goal e l1 /\ interp_list_goal e l2 -> + interp_list_goal e (l1 ++ l2). +intros e; simple induction l1; + [ simpl in |- *; intros l2 [H1 H2]; assumption + | simpl in |- *; intros h1 t1 HR l2 [[H1 H2] H3]; split; auto ]. -Save. +Qed. |