Require terminaison. Require Relations. Require term. Require List. Require equational_theory. Require rpo_extension. Require equational_extension. Require closure_extension. Require term_extension. Require dp. Require Inclusion. Require or_ext_generated. Require ZArith. Require ring_extention. Require Zwf. Require Inverse_Image. Require matrix. Require more_list_extention. Import List. Import ZArith. Set Implicit Arguments. Module algebra. Module F <:term.Signature. Inductive symb : Set := (* id_f *) | id_f : symb (* id_s *) | id_s : symb (* id_0 *) | id_0 : symb . Definition symb_eq_bool (f1 f2:symb) : bool := match f1,f2 with | id_f,id_f => true | id_s,id_s => true | id_0,id_0 => true | _,_ => false end. (* Proof of decidability of equality over symb *) Definition symb_eq_bool_ok(f1 f2:symb) : match symb_eq_bool f1 f2 with | true => f1 = f2 | false => f1 <> f2 end. Proof. intros f1 f2. refine match f1 as u1,f2 as u2 return match symb_eq_bool u1 u2 return Prop with | true => u1 = u2 | false => u1 <> u2 end with | id_f,id_f => refl_equal _ | id_s,id_s => refl_equal _ | id_0,id_0 => refl_equal _ | _,_ => _ end;intros abs;discriminate. Defined. Definition arity (f:symb) := match f with | id_f => term.Free 2 | id_s => term.Free 1 | id_0 => term.Free 0 end. Definition symb_order (f1 f2:symb) : bool := match f1,f2 with | id_f,id_f => true | id_f,id_s => false | id_f,id_0 => false | id_s,id_f => true | id_s,id_s => true | id_s,id_0 => false | id_0,id_f => true | id_0,id_s => true | id_0,id_0 => true end. Module Symb. Definition A := symb. Definition eq_A := @eq A. Definition eq_proof : equivalence A eq_A. Proof. constructor. red ;reflexivity . red ;intros ;transitivity y ;assumption. red ;intros ;symmetry ;assumption. Defined. Add Relation A eq_A reflexivity proved by (@equiv_refl _ _ eq_proof) symmetry proved by (@equiv_sym _ _ eq_proof) transitivity proved by (@equiv_trans _ _ eq_proof) as EQA . Definition eq_bool := symb_eq_bool. Definition eq_bool_ok := symb_eq_bool_ok. End Symb. Export Symb. End F. Module Alg := term.Make'(F)(term_extension.IntVars). Module Alg_ext := term_extension.Make(Alg). Module EQT := equational_theory.Make(Alg). Module EQT_ext := equational_extension.Make(EQT). End algebra. Module R_xml_0_deep_rew. Inductive R_xml_0_rules : algebra.Alg.term ->algebra.Alg.term ->Prop := (* f(0,y_) -> 0 *) | R_xml_0_rule_0 : R_xml_0_rules (algebra.Alg.Term algebra.F.id_0 nil) (algebra.Alg.Term algebra.F.id_f ((algebra.Alg.Term algebra.F.id_0 nil)::(algebra.Alg.Var 1)::nil)) (* f(s(x_),y_) -> f(f(x_,y_),y_) *) | R_xml_0_rule_1 : R_xml_0_rules (algebra.Alg.Term algebra.F.id_f ((algebra.Alg.Term algebra.F.id_f ((algebra.Alg.Var 2):: (algebra.Alg.Var 1)::nil))::(algebra.Alg.Var 1)::nil)) (algebra.Alg.Term algebra.F.id_f ((algebra.Alg.Term algebra.F.id_s ((algebra.Alg.Var 2)::nil))::(algebra.Alg.Var 1)::nil)) . Definition R_xml_0_rule_as_list_0 := ((algebra.Alg.Term algebra.F.id_f ((algebra.Alg.Term algebra.F.id_0 nil):: (algebra.Alg.Var 1)::nil)),(algebra.Alg.Term algebra.F.id_0 nil)):: nil. Definition R_xml_0_rule_as_list_1 := ((algebra.Alg.Term algebra.F.id_f ((algebra.Alg.Term algebra.F.id_s ((algebra.Alg.Var 2)::nil))::(algebra.Alg.Var 1)::nil)), (algebra.Alg.Term algebra.F.id_f ((algebra.Alg.Term algebra.F.id_f ((algebra.Alg.Var 2)::(algebra.Alg.Var 1)::nil)):: (algebra.Alg.Var 1)::nil)))::R_xml_0_rule_as_list_0. Definition R_xml_0_rule_as_list := R_xml_0_rule_as_list_1. Lemma R_xml_0_rules_included : forall l r, R_xml_0_rules r l <-> In (l,r) R_xml_0_rule_as_list. Proof. intros l r. constructor. intros H. case H;clear H; (apply (more_list.mem_impl_in (@eq (algebra.Alg.term*algebra.Alg.term))); [tauto|idtac]); match goal with | |- _ _ _ ?t ?l => let u := fresh "u" in (generalize (more_list.mem_bool_ok _ _ algebra.Alg_ext.eq_term_term_bool_ok t l); set (u:=more_list.mem_bool algebra.Alg_ext.eq_term_term_bool t l) in *; vm_compute in u|-;unfold u in *;clear u;intros H;refine H) end . intros H. vm_compute in H|-. rewrite <- or_ext_generated.or3_equiv in H|-. case H;clear H;intros H. injection H;intros ;subst;constructor 2. injection H;intros ;subst;constructor 1. elim H. Qed. Lemma R_xml_0_non_var : forall x t, ~R_xml_0_rules t (algebra.EQT.T.Var x). Proof. intros x t H. inversion H. Qed. Lemma R_xml_0_reg : forall s t, (R_xml_0_rules s t) -> forall x, In x (algebra.Alg.var_list s) ->In x (algebra.Alg.var_list t). Proof. intros s t H. inversion H;intros x Hx; (apply (more_list.mem_impl_in (@eq algebra.Alg.variable));[tauto|idtac]); apply (more_list.in_impl_mem (@eq algebra.Alg.variable)) in Hx; vm_compute in Hx|-*;tauto. Qed. Inductive and_2 (x4 x5:Prop) : Prop := | conj_2 : x4->x5->and_2 x4 x5 . Lemma are_constuctors_of_R_xml_0 : forall t t', (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) t' t) -> and_2 (forall x5, t = (algebra.Alg.Term algebra.F.id_s (x5::nil)) -> exists x4, t' = (algebra.Alg.Term algebra.F.id_s (x4::nil))/\ (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) x4 x5)) (t = (algebra.Alg.Term algebra.F.id_0 nil) -> t' = (algebra.Alg.Term algebra.F.id_0 nil)). Proof. intros t t' H. induction H as [|y IH z z_to_y] using closure_extension.refl_trans_clos_ind2. constructor 1. intros x5 H;exists x5;intuition;constructor 1. intros H;intuition;constructor 1. inversion z_to_y as [t1 t2 H H0 H1|f l1 l2 H0 H H2];clear z_to_y;subst. inversion H as [t1 t2 sigma H2 H1 H0];clear H IH;subst;inversion H2; clear ;constructor;try (intros until 0 );clear ;intros abs; discriminate abs. destruct IH as [H_id_s H_id_0]. constructor. clear H_id_0;intros x5 H;injection H;clear H;intros ;subst; repeat ( match goal with | H:closure.one_step_list (algebra.EQT.one_step _) _ _ |- _ => inversion H;clear H;subst end ). match goal with | H:algebra.EQT.one_step _ ?y x5 |- _ => destruct (H_id_s y (refl_equal _)) as [x4];intros ;intuition;exists x4; intuition;eapply closure_extension.refl_trans_clos_R;eassumption end . clear H_id_s;intros H;injection H;clear H;intros ;subst; repeat ( match goal with | H:closure.one_step_list (algebra.EQT.one_step _) _ _ |- _ => inversion H;clear H;subst end ). Qed. Lemma id_s_is_R_xml_0_constructor : forall t t', (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) t' t) -> forall x5, t = (algebra.Alg.Term algebra.F.id_s (x5::nil)) -> exists x4, t' = (algebra.Alg.Term algebra.F.id_s (x4::nil))/\ (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) x4 x5). Proof. intros t t' H. destruct (are_constuctors_of_R_xml_0 H). assumption. Qed. Lemma id_0_is_R_xml_0_constructor : forall t t', (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) t' t) -> t = (algebra.Alg.Term algebra.F.id_0 nil) -> t' = (algebra.Alg.Term algebra.F.id_0 nil). Proof. intros t t' H. destruct (are_constuctors_of_R_xml_0 H). assumption. Qed. Ltac impossible_star_reduction_R_xml_0 := match goal with | H:closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) _ (algebra.Alg.Term algebra.F.id_s (?x4::nil)) |- _ => let x4 := fresh "x" in (let Heq := fresh "Heq" in (let Hred1 := fresh "Hred" in (destruct (id_s_is_R_xml_0_constructor H (refl_equal _)) as [x4 [Heq Hred1]]; (discriminate Heq)|| (injection Heq;intros ;subst;clear Heq;clear H; impossible_star_reduction_R_xml_0 )))) | H:closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) _ (algebra.Alg.Term algebra.F.id_0 nil) |- _ => let Heq := fresh "Heq" in (set (Heq:=id_0_is_R_xml_0_constructor H (refl_equal _)) in *; (discriminate Heq)|| (clearbody Heq;try (subst);try (clear Heq);clear H; impossible_star_reduction_R_xml_0 )) end . Ltac simplify_star_reduction_R_xml_0 := match goal with | H:closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) _ (algebra.Alg.Term algebra.F.id_s (?x4::nil)) |- _ => let x4 := fresh "x" in (let Heq := fresh "Heq" in (let Hred1 := fresh "Hred" in (destruct (id_s_is_R_xml_0_constructor H (refl_equal _)) as [x4 [Heq Hred1]]; (discriminate Heq)|| (injection Heq;intros ;subst;clear Heq;clear H; try (simplify_star_reduction_R_xml_0 ))))) | H:closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) _ (algebra.Alg.Term algebra.F.id_0 nil) |- _ => let Heq := fresh "Heq" in (set (Heq:=id_0_is_R_xml_0_constructor H (refl_equal _)) in *; (discriminate Heq)|| (clearbody Heq;try (subst);try (clear Heq);clear H; try (simplify_star_reduction_R_xml_0 ))) end . End R_xml_0_deep_rew. Module InterpGen := interp.Interp(algebra.EQT). Module ddp := dp.MakeDP(algebra.EQT). Module SymbType. Definition A := algebra.Alg.F.Symb.A. End SymbType. Module Symb_more_list := more_list_extention.Make(SymbType)(algebra.Alg.F.Symb). Module SymbSet := list_set.Make(algebra.F.Symb). Module Interp. Section S. Require Import interp. Hypothesis A : Type. Hypothesis Ale Alt Aeq : A -> A -> Prop. Hypothesis Aop : interp.ordering_pair Aeq Alt Ale. Hypothesis A0 : A. Notation Local "a <= b" := (Ale a b). Hypothesis P_id_f : A ->A ->A. Hypothesis P_id_s : A ->A. Hypothesis P_id_0 : A. Hypothesis P_id_f_monotonic : forall x4 x6 x5 x7, (A0 <= x7)/\ (x7 <= x6) -> (A0 <= x5)/\ (x5 <= x4) ->P_id_f x5 x7 <= P_id_f x4 x6. Hypothesis P_id_s_monotonic : forall x4 x5, (A0 <= x5)/\ (x5 <= x4) ->P_id_s x5 <= P_id_s x4. Hypothesis P_id_f_bounded : forall x4 x5, (A0 <= x4) ->(A0 <= x5) ->A0 <= P_id_f x5 x4. Hypothesis P_id_s_bounded : forall x4, (A0 <= x4) ->A0 <= P_id_s x4. Hypothesis P_id_0_bounded : A0 <= P_id_0 . Fixpoint measure t { struct t } := match t with | (algebra.Alg.Term algebra.F.id_f (x5::x4::nil)) => P_id_f (measure x5) (measure x4) | (algebra.Alg.Term algebra.F.id_s (x4::nil)) => P_id_s (measure x4) | (algebra.Alg.Term algebra.F.id_0 nil) => P_id_0 | _ => A0 end. Lemma measure_equation : forall t, measure t = match t with | (algebra.Alg.Term algebra.F.id_f (x5::x4::nil)) => P_id_f (measure x5) (measure x4) | (algebra.Alg.Term algebra.F.id_s (x4::nil)) => P_id_s (measure x4) | (algebra.Alg.Term algebra.F.id_0 nil) => P_id_0 | _ => A0 end. Proof. intros t;case t;intros ;apply refl_equal. Qed. Definition Pols f : InterpGen.Pol_type A (InterpGen.get_arity f) := match f with | algebra.F.id_f => P_id_f | algebra.F.id_s => P_id_s | algebra.F.id_0 => P_id_0 end. Lemma same_measure : forall t, measure t = InterpGen.measure A0 Pols t. Proof. fix 1 . intros [a| f l]. simpl in |-*. unfold eq_rect_r, eq_rect, sym_eq in |-*. reflexivity . refine match f with | algebra.F.id_f => match l with | nil => _ | _::nil => _ | _::_::nil => _ | _::_::_::_ => _ end | algebra.F.id_s => match l with | nil => _ | _::nil => _ | _::_::_ => _ end | algebra.F.id_0 => match l with | nil => _ | _::_ => _ end end;simpl in |-*;unfold eq_rect_r, eq_rect, sym_eq in |-*; try (reflexivity );f_equal ;auto. Qed. Lemma measure_bounded : forall t, A0 <= measure t. Proof. intros t. rewrite same_measure in |-*. apply (InterpGen.measure_bounded Aop). intros f. case f. vm_compute in |-*;intros ;apply P_id_f_bounded;assumption. vm_compute in |-*;intros ;apply P_id_s_bounded;assumption. vm_compute in |-*;intros ;apply P_id_0_bounded;assumption. Qed. Ltac generate_pos_hyp := match goal with | H:context [measure ?x] |- _ => let v := fresh "v" in (let H := fresh "h" in (set (H:=measure_bounded x) in *;set (v:=measure x) in *; clearbody H;clearbody v)) | |- context [measure ?x] => let v := fresh "v" in (let H := fresh "h" in (set (H:=measure_bounded x) in *;set (v:=measure x) in *; clearbody H;clearbody v)) end . Hypothesis rules_monotonic : forall l r, (algebra.EQT.axiom R_xml_0_deep_rew.R_xml_0_rules r l) -> measure r <= measure l. Lemma measure_star_monotonic : forall l r, (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_deep_rew.R_xml_0_rules) r l) ->measure r <= measure l. Proof. intros . do 2 (rewrite same_measure in |-*). apply InterpGen.measure_star_monotonic with (1:=Aop) (Pols:=Pols) (rules:=R_xml_0_deep_rew.R_xml_0_rules). intros f. case f. vm_compute in |-*;intros ;apply P_id_f_monotonic;assumption. vm_compute in |-*;intros ;apply P_id_s_monotonic;assumption. vm_compute in |-*;apply (Aop.(le_refl)). intros f. case f. vm_compute in |-*;intros ;apply P_id_f_bounded;assumption. vm_compute in |-*;intros ;apply P_id_s_bounded;assumption. vm_compute in |-*;intros ;apply P_id_0_bounded;assumption. intros . do 2 (rewrite <- same_measure in |-*). apply rules_monotonic;assumption. assumption. Qed. Hypothesis P_id_F : A ->A ->A. Hypothesis P_id_F_monotonic : forall x4 x6 x5 x7, (A0 <= x7)/\ (x7 <= x6) -> (A0 <= x5)/\ (x5 <= x4) ->P_id_F x5 x7 <= P_id_F x4 x6. Definition marked_measure t := match t with | (algebra.Alg.Term algebra.F.id_f (x5::x4::nil)) => P_id_F (measure x5) (measure x4) | _ => measure t end. Definition Marked_pols : forall f, (algebra.EQT.defined R_xml_0_deep_rew.R_xml_0_rules f) -> InterpGen.Pol_type A (InterpGen.get_arity f). Proof. intros f H. apply ddp.defined_list_complete with (1:=R_xml_0_deep_rew.R_xml_0_rules_included) in H . apply (Symb_more_list.change_in algebra.F.symb_order) in H . set (u := (Symb_more_list.qs algebra.F.symb_order (Symb_more_list.XSet.remove_red (ddp.defined_list R_xml_0_deep_rew.R_xml_0_rule_as_list)))) in * . vm_compute in u . unfold u in * . clear u . unfold more_list.mem_bool in H . match type of H with | orb ?a ?b = true => assert (H':{a = true}+{b = true});[ revert H;case a;[left;reflexivity|simpl;intros h;right;exact h]| clear H;destruct H' as [H|H]] end . match type of H with | _ _ ?t = true => generalize (algebra.F.symb_eq_bool_ok f t); unfold algebra.Alg.eq_symb_bool in H; rewrite H;clear H;intros ;subst end . vm_compute in |-*;intros x5 x4;apply (P_id_F x5 x4). discriminate H. Defined. Lemma same_marked_measure : forall t, marked_measure t = InterpGen.marked_measure A0 Pols Marked_pols (ddp.defined_dec _ _ R_xml_0_deep_rew.R_xml_0_rules_included) t. Proof. intros [a| f l]. simpl in |-*. unfold eq_rect_r, eq_rect, sym_eq in |-*. reflexivity . refine match f with | algebra.F.id_f => match l with | nil => _ | _::nil => _ | _::_::nil => _ | _::_::_::_ => _ end | algebra.F.id_s => match l with | nil => _ | _::nil => _ | _::_::_ => _ end | algebra.F.id_0 => match l with | nil => _ | _::_ => _ end end. vm_compute in |-*;reflexivity . vm_compute in |-*;reflexivity . lazy - [measure InterpGen.measure Pols] in |-* ;f_equal ; apply same_measure. vm_compute in |-*;reflexivity . vm_compute in |-*;reflexivity . lazy - [measure InterpGen.measure Pols] in |-* ;f_equal ; apply same_measure. vm_compute in |-*;reflexivity . vm_compute in |-*;reflexivity . vm_compute in |-*;reflexivity . Qed. Lemma marked_measure_equation : forall t, marked_measure t = match t with | (algebra.Alg.Term algebra.F.id_f (x5::x4::nil)) => P_id_F (measure x5) (measure x4) | _ => measure t end. Proof. reflexivity . Qed. Lemma marked_measure_star_monotonic : forall f l1 l2, (closure.refl_trans_clos (closure.one_step_list (algebra.EQT.one_step R_xml_0_deep_rew.R_xml_0_rules) ) l1 l2) -> marked_measure (algebra.Alg.Term f l1) <= marked_measure (algebra.Alg.Term f l2). Proof. intros . do 2 (rewrite same_marked_measure in |-*). apply InterpGen.marked_measure_star_monotonic with (1:=Aop) (Pols:= Pols) (rules:=R_xml_0_deep_rew.R_xml_0_rules). clear f. intros f. case f. vm_compute in |-*;intros ;apply P_id_f_monotonic;assumption. vm_compute in |-*;intros ;apply P_id_s_monotonic;assumption. vm_compute in |-*;apply (Aop.(le_refl)). clear f. intros f. case f. vm_compute in |-*;intros ;apply P_id_f_bounded;assumption. vm_compute in |-*;intros ;apply P_id_s_bounded;assumption. vm_compute in |-*;intros ;apply P_id_0_bounded;assumption. intros . do 2 (rewrite <- same_measure in |-*). apply rules_monotonic;assumption. clear f. intros f. clear H. intros H. generalize H. apply ddp.defined_list_complete with (1:=R_xml_0_deep_rew.R_xml_0_rules_included) in H . apply (Symb_more_list.change_in algebra.F.symb_order) in H . set (u := (Symb_more_list.qs algebra.F.symb_order (Symb_more_list.XSet.remove_red (ddp.defined_list R_xml_0_deep_rew.R_xml_0_rule_as_list)))) in * . vm_compute in u . unfold u in * . clear u . unfold more_list.mem_bool in H . match type of H with | orb ?a ?b = true => assert (H':{a = true}+{b = true});[ revert H;case a;[left;reflexivity|simpl;intros h;right;exact h]| clear H;destruct H' as [H|H]] end . match type of H with | _ _ ?t = true => generalize (algebra.F.symb_eq_bool_ok f t); unfold algebra.Alg.eq_symb_bool in H; rewrite H;clear H;intros ;subst end . vm_compute in |-*;intros ;apply P_id_F_monotonic;assumption. discriminate H. assumption. Qed. End S. End Interp. Module InterpZ. Section S. Open Scope Z_scope. Hypothesis min_value : Z. Import ring_extention. Notation Local "'Alt'" := (Zwf.Zwf min_value). Notation Local "'Ale'" := Zle. Notation Local "'Aeq'" := (@eq Z). Notation Local "a <= b" := (Ale a b). Notation Local "a < b" := (Alt a b). Hypothesis P_id_f : Z ->Z ->Z. Hypothesis P_id_s : Z ->Z. Hypothesis P_id_0 : Z. Hypothesis P_id_f_monotonic : forall x4 x6 x5 x7, (min_value <= x7)/\ (x7 <= x6) -> (min_value <= x5)/\ (x5 <= x4) ->P_id_f x5 x7 <= P_id_f x4 x6. Hypothesis P_id_s_monotonic : forall x4 x5, (min_value <= x5)/\ (x5 <= x4) ->P_id_s x5 <= P_id_s x4. Hypothesis P_id_f_bounded : forall x4 x5, (min_value <= x4) ->(min_value <= x5) ->min_value <= P_id_f x5 x4. Hypothesis P_id_s_bounded : forall x4, (min_value <= x4) ->min_value <= P_id_s x4. Hypothesis P_id_0_bounded : min_value <= P_id_0 . Definition measure := Interp.measure min_value P_id_f P_id_s P_id_0. Lemma measure_equation : forall t, measure t = match t with | (algebra.Alg.Term algebra.F.id_f (x5::x4::nil)) => P_id_f (measure x5) (measure x4) | (algebra.Alg.Term algebra.F.id_s (x4::nil)) => P_id_s (measure x4) | (algebra.Alg.Term algebra.F.id_0 nil) => P_id_0 | _ => min_value end. Proof. intros t;case t;intros ;apply refl_equal. Qed. Lemma measure_bounded : forall t, min_value <= measure t. Proof. unfold measure in |-*. apply Interp.measure_bounded with Alt Aeq; (apply interp.o_Z)|| (cbv beta iota zeta delta - [Zle Zlt Zplus Zmult] ;auto with zarith). Qed. Ltac generate_pos_hyp := match goal with | H:context [measure ?x] |- _ => let v := fresh "v" in (let H := fresh "h" in (set (H:=measure_bounded x) in *;set (v:=measure x) in *; clearbody H;clearbody v)) | |- context [measure ?x] => let v := fresh "v" in (let H := fresh "h" in (set (H:=measure_bounded x) in *;set (v:=measure x) in *; clearbody H;clearbody v)) end . Hypothesis rules_monotonic : forall l r, (algebra.EQT.axiom R_xml_0_deep_rew.R_xml_0_rules r l) -> measure r <= measure l. Lemma measure_star_monotonic : forall l r, (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_deep_rew.R_xml_0_rules) r l) ->measure r <= measure l. Proof. unfold measure in *. apply Interp.measure_star_monotonic with Alt Aeq. (apply interp.o_Z)|| (cbv beta iota zeta delta - [Zle Zlt Zplus Zmult] ;auto with zarith). intros ;apply P_id_f_monotonic;assumption. intros ;apply P_id_s_monotonic;assumption. intros ;apply P_id_f_bounded;assumption. intros ;apply P_id_s_bounded;assumption. intros ;apply P_id_0_bounded;assumption. apply rules_monotonic. Qed. Hypothesis P_id_F : Z ->Z ->Z. Hypothesis P_id_F_monotonic : forall x4 x6 x5 x7, (min_value <= x7)/\ (x7 <= x6) -> (min_value <= x5)/\ (x5 <= x4) ->P_id_F x5 x7 <= P_id_F x4 x6. Definition marked_measure := Interp.marked_measure min_value P_id_f P_id_s P_id_0 P_id_F. Lemma marked_measure_equation : forall t, marked_measure t = match t with | (algebra.Alg.Term algebra.F.id_f (x5::x4::nil)) => P_id_F (measure x5) (measure x4) | _ => measure t end. Proof. reflexivity . Qed. Lemma marked_measure_star_monotonic : forall f l1 l2, (closure.refl_trans_clos (closure.one_step_list (algebra.EQT.one_step R_xml_0_deep_rew.R_xml_0_rules) ) l1 l2) -> marked_measure (algebra.Alg.Term f l1) <= marked_measure (algebra.Alg.Term f l2). Proof. unfold marked_measure in *. apply Interp.marked_measure_star_monotonic with Alt Aeq. (apply interp.o_Z)|| (cbv beta iota zeta delta - [Zle Zlt Zplus Zmult] ;auto with zarith). intros ;apply P_id_f_monotonic;assumption. intros ;apply P_id_s_monotonic;assumption. intros ;apply P_id_f_bounded;assumption. intros ;apply P_id_s_bounded;assumption. intros ;apply P_id_0_bounded;assumption. apply rules_monotonic. intros ;apply P_id_F_monotonic;assumption. Qed. End S. End InterpZ. Module WF_R_xml_0_deep_rew. Inductive DP_R_xml_0 : algebra.Alg.term ->algebra.Alg.term ->Prop := (* *) | DP_R_xml_0_0 : forall x4 x2 x1 x5, (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_deep_rew.R_xml_0_rules) (algebra.Alg.Term algebra.F.id_s (x2::nil)) x5) -> (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_deep_rew.R_xml_0_rules) x1 x4) -> DP_R_xml_0 (algebra.Alg.Term algebra.F.id_f ((algebra.Alg.Term algebra.F.id_f (x2::x1::nil))::x1::nil)) (algebra.Alg.Term algebra.F.id_f (x5::x4::nil)) (* *) | DP_R_xml_0_1 : forall x4 x2 x1 x5, (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_deep_rew.R_xml_0_rules) (algebra.Alg.Term algebra.F.id_s (x2::nil)) x5) -> (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_deep_rew.R_xml_0_rules) x1 x4) -> DP_R_xml_0 (algebra.Alg.Term algebra.F.id_f (x2::x1::nil)) (algebra.Alg.Term algebra.F.id_f (x5::x4::nil)) . Module ddp := dp.MakeDP(algebra.EQT). Lemma R_xml_0_dp_step_spec : forall x y, (ddp.dp_step R_xml_0_deep_rew.R_xml_0_rules x y) -> exists f, exists l1, exists l2, y = algebra.Alg.Term f l2/\ (closure.refl_trans_clos (closure.one_step_list (algebra.EQT.one_step R_xml_0_deep_rew.R_xml_0_rules) ) l1 l2)/\ (ddp.dp R_xml_0_deep_rew.R_xml_0_rules x (algebra.Alg.Term f l1)). Proof. intros x y H. induction H. inversion H. subst. destruct t0. refine ((False_ind) _ _). refine (R_xml_0_deep_rew.R_xml_0_non_var H0). simpl in H|-*. exists a. exists ((List.map) (algebra.Alg.apply_subst sigma) l). exists ((List.map) (algebra.Alg.apply_subst sigma) l). repeat (constructor). assumption. exists f. exists l2. exists l1. constructor. constructor. constructor. constructor. rewrite <- closure.rwr_list_trans_clos_one_step_list. assumption. assumption. Qed. Ltac included_dp_tac H := injection H;clear H;intros;subst; repeat (match goal with | H: closure.refl_trans_clos (closure.one_step_list _) (_::_) _ |- _=> let x := fresh "x" in let l := fresh "l" in let h1 := fresh "h" in let h2 := fresh "h" in let h3 := fresh "h" in destruct (@algebra.EQT_ext.one_step_list_star_decompose_cons _ _ _ _ H) as [x [l[h1[h2 h3]]]];clear H;subst | H: closure.refl_trans_clos (closure.one_step_list _) nil _ |- _ => rewrite (@algebra.EQT_ext.one_step_list_star_decompose_nil _ _ H) in *;clear H end );simpl; econstructor eassumption . Ltac dp_concl_tac h2 h cont_tac t := match t with | False => let h' := fresh "a" in (set (h':=t) in *;cont_tac h'; repeat ( let e := type of h in (match e with | ?t => unfold t in h|-; (case h; [abstract (clear h;intros h;injection h; clear h;intros ;subst; included_dp_tac h2)| clear h;intros h;clear t]) | ?t => unfold t in h|-;elim h end ) )) | or ?a ?b => let cont_tac h' := let h'' := fresh "a" in (set (h'':=or a h') in *;cont_tac h'') in (dp_concl_tac h2 h cont_tac b) end . Module WF_DP_R_xml_0. Open Scope Z_scope. Import ring_extention. Notation Local "a <= b" := (Zle a b). Notation Local "a < b" := (Zlt a b). Definition P_id_f (x4:Z) (x5:Z) := 1 + 1* x4. Definition P_id_s (x4:Z) := 3 + 2* x4. Definition P_id_0 := 3. Lemma P_id_f_monotonic : forall x4 x6 x5 x7, (3 <= x7)/\ (x7 <= x6) -> (3 <= x5)/\ (x5 <= x4) ->P_id_f x5 x7 <= P_id_f x4 x6. Proof. intros x7 x6 x5 x4. intros [H_1 H_0]. intros [H_3 H_2]. cbv beta iota zeta delta - [Zle Zlt Zplus Zmult] ;intuition; (auto with zarith)||(repeat (translate_vars );prove_ineq ). Qed. Lemma P_id_s_monotonic : forall x4 x5, (3 <= x5)/\ (x5 <= x4) ->P_id_s x5 <= P_id_s x4. Proof. intros x5 x4. intros [H_1 H_0]. cbv beta iota zeta delta - [Zle Zlt Zplus Zmult] ;intuition; (auto with zarith)||(repeat (translate_vars );prove_ineq ). Qed. Lemma P_id_f_bounded : forall x4 x5, (3 <= x4) ->(3 <= x5) ->3 <= P_id_f x5 x4. Proof. intros . cbv beta iota zeta delta - [Zle Zlt Zplus Zmult] ;intuition; (auto with zarith)||(repeat (translate_vars );prove_ineq ). Qed. Lemma P_id_s_bounded : forall x4, (3 <= x4) ->3 <= P_id_s x4. Proof. intros . cbv beta iota zeta delta - [Zle Zlt Zplus Zmult] ;intuition; (auto with zarith)||(repeat (translate_vars );prove_ineq ). Qed. Lemma P_id_0_bounded : 3 <= P_id_0 . Proof. intros . cbv beta iota zeta delta - [Zle Zlt Zplus Zmult] ;intuition; (auto with zarith)||(repeat (translate_vars );prove_ineq ). Qed. Definition measure := InterpZ.measure 3 P_id_f P_id_s P_id_0. Lemma measure_equation : forall t, measure t = match t with | (algebra.Alg.Term algebra.F.id_f (x5::x4::nil)) => P_id_f (measure x5) (measure x4) | (algebra.Alg.Term algebra.F.id_s (x4::nil)) => P_id_s (measure x4) | (algebra.Alg.Term algebra.F.id_0 nil) => P_id_0 | _ => 3 end. Proof. intros t;case t;intros ;apply refl_equal. Qed. Lemma measure_bounded : forall t, 3 <= measure t. Proof. unfold measure in |-*. apply InterpZ.measure_bounded; cbv beta iota zeta delta - [Zle Zlt Zplus Zmult] ;intuition; (auto with zarith)||(repeat (translate_vars );prove_ineq ). Qed. Ltac generate_pos_hyp := match goal with | H:context [measure ?x] |- _ => let v := fresh "v" in (let H := fresh "h" in (set (H:=measure_bounded x) in *;set (v:=measure x) in *; clearbody H;clearbody v)) | |- context [measure ?x] => let v := fresh "v" in (let H := fresh "h" in (set (H:=measure_bounded x) in *;set (v:=measure x) in *; clearbody H;clearbody v)) end . Lemma rules_monotonic : forall l r, (algebra.EQT.axiom R_xml_0_deep_rew.R_xml_0_rules r l) -> measure r <= measure l. Proof. intros l r H. fold measure in |-*. inversion H;clear H;subst;inversion H0;clear H0;subst; simpl algebra.EQT.T.apply_subst in |-*; repeat ( match goal with | |- context [measure (algebra.Alg.Term ?f ?t)] => rewrite (measure_equation (algebra.Alg.Term f t)) end );repeat (generate_pos_hyp ); cbv beta iota zeta delta - [Zle Zlt Zplus Zmult] ;intuition; (auto with zarith)||(repeat (translate_vars );prove_ineq ). Qed. Lemma measure_star_monotonic : forall l r, (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_deep_rew.R_xml_0_rules) r l) ->measure r <= measure l. Proof. unfold measure in *. apply InterpZ.measure_star_monotonic. intros ;apply P_id_f_monotonic;assumption. intros ;apply P_id_s_monotonic;assumption. intros ;apply P_id_f_bounded;assumption. intros ;apply P_id_s_bounded;assumption. intros ;apply P_id_0_bounded;assumption. apply rules_monotonic. Qed. Definition P_id_F (x4:Z) (x5:Z) := 2* x4. Lemma P_id_F_monotonic : forall x4 x6 x5 x7, (3 <= x7)/\ (x7 <= x6) -> (3 <= x5)/\ (x5 <= x4) ->P_id_F x5 x7 <= P_id_F x4 x6. Proof. intros x7 x6 x5 x4. intros [H_1 H_0]. intros [H_3 H_2]. cbv beta iota zeta delta - [Zle Zlt Zplus Zmult] ;intuition; (auto with zarith)||(repeat (translate_vars );prove_ineq ). Qed. Definition marked_measure := InterpZ.marked_measure 3 P_id_f P_id_s P_id_0 P_id_F. Lemma marked_measure_equation : forall t, marked_measure t = match t with | (algebra.Alg.Term algebra.F.id_f (x5::x4::nil)) => P_id_F (measure x5) (measure x4) | _ => measure t end. Proof. reflexivity . Qed. Lemma marked_measure_star_monotonic : forall f l1 l2, (closure.refl_trans_clos (closure.one_step_list (algebra.EQT.one_step R_xml_0_deep_rew.R_xml_0_rules) ) l1 l2) -> marked_measure (algebra.Alg.Term f l1) <= marked_measure (algebra.Alg.Term f l2). Proof. unfold marked_measure in *. apply InterpZ.marked_measure_star_monotonic. intros ;apply P_id_f_monotonic;assumption. intros ;apply P_id_s_monotonic;assumption. intros ;apply P_id_f_bounded;assumption. intros ;apply P_id_s_bounded;assumption. intros ;apply P_id_0_bounded;assumption. apply rules_monotonic. intros ;apply P_id_F_monotonic;assumption. Qed. Ltac rewrite_and_unfold := do 2 (rewrite marked_measure_equation); repeat ( match goal with | |- context [measure (algebra.Alg.Term ?f ?t)] => rewrite (measure_equation (algebra.Alg.Term f t)) | H:context [measure (algebra.Alg.Term ?f ?t)] |- _ => rewrite (measure_equation (algebra.Alg.Term f t)) in H|- end ). Lemma wf : well_founded WF_R_xml_0_deep_rew.DP_R_xml_0. Proof. intros x. apply well_founded_ind with (R:=fun x y => (Zwf.Zwf 3) (marked_measure x) (marked_measure y)). apply Inverse_Image.wf_inverse_image with (B:=Z). apply Zwf.Zwf_well_founded. clear x. intros x IHx. repeat ( constructor;inversion 1;subst; full_prove_ineq algebra.Alg.Term ltac:(algebra.Alg_ext.find_replacement ) algebra.EQT_ext.one_step_list_refl_trans_clos marked_measure marked_measure_star_monotonic (Zwf.Zwf 3) (interp.o_Z 3) ltac:(fun _ => R_xml_0_deep_rew.impossible_star_reduction_R_xml_0 ) ltac:(fun _ => rewrite_and_unfold ) ltac:(fun _ => generate_pos_hyp ) ltac:(fun _ => cbv beta iota zeta delta - [Zplus Zmult Zle Zlt] in * ; try (constructor)) IHx ). Qed. End WF_DP_R_xml_0. Definition wf_H := WF_DP_R_xml_0.wf. Lemma wf : well_founded (algebra.EQT.one_step R_xml_0_deep_rew.R_xml_0_rules). Proof. apply ddp.dp_criterion. apply R_xml_0_deep_rew.R_xml_0_non_var. apply R_xml_0_deep_rew.R_xml_0_reg. intros ; apply (ddp.constructor_defined_dec _ _ R_xml_0_deep_rew.R_xml_0_rules_included). refine (Inclusion.wf_incl _ _ _ _ wf_H). intros x y H. destruct (R_xml_0_dp_step_spec H) as [f [l1 [l2 [H1 [H2 H3]]]]]. destruct (ddp.dp_list_complete _ _ R_xml_0_deep_rew.R_xml_0_rules_included _ _ H3) as [x' [y' [sigma [h1 [h2 h3]]]]]. clear H3. subst. vm_compute in h3|-. let e := type of h3 in (dp_concl_tac h2 h3 ltac:(fun _ => idtac) e). Qed. End WF_R_xml_0_deep_rew. (* *** Local Variables: *** *** coq-prog-name: "coqtop" *** *** coq-prog-args: ("-emacs-U" "-I" "$COCCINELLE/examples" "-I" "$COCCINELLE/term_algebra" "-I" "$COCCINELLE/term_orderings" "-I" "$COCCINELLE/basis" "-I" "$COCCINELLE/list_extensions" "-I" "$COCCINELLE/examples/cime_trace/") *** *** compile-command: "coqc -I $COCCINELLE/term_algebra -I $COCCINELLE/term_orderings -I $COCCINELLE/basis -I $COCCINELLE/list_extensions -I $COCCINELLE/examples/cime_trace/ -I $COCCINELLE/examples/ c_output/strat/tpdb-5.0___TRS___AG01___3.23.trs/a3pat.v" *** *** End: *** *)