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_not *) | id_not : symb (* id_and *) | id_and : symb (* id_true *) | id_true : symb (* id__equal_ *) | id__equal_ : symb (* id_xor *) | id_xor : symb (* id_or *) | id_or : symb (* id_implies *) | id_implies : symb . Definition symb_eq_bool (f1 f2:symb) : bool := match f1,f2 with | id_not,id_not => true | id_and,id_and => true | id_true,id_true => true | id__equal_,id__equal_ => true | id_xor,id_xor => true | id_or,id_or => true | id_implies,id_implies => 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_not,id_not => refl_equal _ | id_and,id_and => refl_equal _ | id_true,id_true => refl_equal _ | id__equal_,id__equal_ => refl_equal _ | id_xor,id_xor => refl_equal _ | id_or,id_or => refl_equal _ | id_implies,id_implies => refl_equal _ | _,_ => _ end;intros abs;discriminate. Defined. Definition arity (f:symb) := match f with | id_not => term.Free 1 | id_and => term.Free 2 | id_true => term.Free 0 | id__equal_ => term.Free 2 | id_xor => term.Free 2 | id_or => term.Free 2 | id_implies => term.Free 2 end. Definition symb_order (f1 f2:symb) : bool := match f1,f2 with | id_not,id_not => true | id_not,id_and => false | id_not,id_true => false | id_not,id__equal_ => false | id_not,id_xor => false | id_not,id_or => false | id_not,id_implies => false | id_and,id_not => true | id_and,id_and => true | id_and,id_true => false | id_and,id__equal_ => false | id_and,id_xor => false | id_and,id_or => false | id_and,id_implies => false | id_true,id_not => true | id_true,id_and => true | id_true,id_true => true | id_true,id__equal_ => false | id_true,id_xor => false | id_true,id_or => false | id_true,id_implies => false | id__equal_,id_not => true | id__equal_,id_and => true | id__equal_,id_true => true | id__equal_,id__equal_ => true | id__equal_,id_xor => false | id__equal_,id_or => false | id__equal_,id_implies => false | id_xor,id_not => true | id_xor,id_and => true | id_xor,id_true => true | id_xor,id__equal_ => true | id_xor,id_xor => true | id_xor,id_or => false | id_xor,id_implies => false | id_or,id_not => true | id_or,id_and => true | id_or,id_true => true | id_or,id__equal_ => true | id_or,id_xor => true | id_or,id_or => true | id_or,id_implies => false | id_implies,id_not => true | id_implies,id_and => true | id_implies,id_true => true | id_implies,id__equal_ => true | id_implies,id_xor => true | id_implies,id_or => true | id_implies,id_implies => 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 := (* not(x_) -> xor(x_,true) *) | R_xml_0_rule_0 : R_xml_0_rules (algebra.Alg.Term algebra.F.id_xor ((algebra.Alg.Var 1):: (algebra.Alg.Term algebra.F.id_true nil)::nil)) (algebra.Alg.Term algebra.F.id_not ((algebra.Alg.Var 1)::nil)) (* implies(x_,y_) -> xor(and(x_,y_),xor(x_,true)) *) | R_xml_0_rule_1 : R_xml_0_rules (algebra.Alg.Term algebra.F.id_xor ((algebra.Alg.Term algebra.F.id_and ((algebra.Alg.Var 1):: (algebra.Alg.Var 2)::nil))::(algebra.Alg.Term algebra.F.id_xor ((algebra.Alg.Var 1)::(algebra.Alg.Term algebra.F.id_true nil)::nil))::nil)) (algebra.Alg.Term algebra.F.id_implies ((algebra.Alg.Var 1):: (algebra.Alg.Var 2)::nil)) (* or(x_,y_) -> xor(and(x_,y_),xor(x_,y_)) *) | R_xml_0_rule_2 : R_xml_0_rules (algebra.Alg.Term algebra.F.id_xor ((algebra.Alg.Term algebra.F.id_and ((algebra.Alg.Var 1):: (algebra.Alg.Var 2)::nil))::(algebra.Alg.Term algebra.F.id_xor ((algebra.Alg.Var 1):: (algebra.Alg.Var 2)::nil))::nil)) (algebra.Alg.Term algebra.F.id_or ((algebra.Alg.Var 1):: (algebra.Alg.Var 2)::nil)) (* =(x_,y_) -> xor(x_,xor(y_,true)) *) | R_xml_0_rule_3 : R_xml_0_rules (algebra.Alg.Term algebra.F.id_xor ((algebra.Alg.Var 1):: (algebra.Alg.Term algebra.F.id_xor ((algebra.Alg.Var 2):: (algebra.Alg.Term algebra.F.id_true nil)::nil))::nil)) (algebra.Alg.Term algebra.F.id__equal_ ((algebra.Alg.Var 1):: (algebra.Alg.Var 2)::nil)) . Definition R_xml_0_rule_as_list_0 := ((algebra.Alg.Term algebra.F.id_not ((algebra.Alg.Var 1)::nil)), (algebra.Alg.Term algebra.F.id_xor ((algebra.Alg.Var 1):: (algebra.Alg.Term algebra.F.id_true nil)::nil)))::nil. Definition R_xml_0_rule_as_list_1 := ((algebra.Alg.Term algebra.F.id_implies ((algebra.Alg.Var 1):: (algebra.Alg.Var 2)::nil)), (algebra.Alg.Term algebra.F.id_xor ((algebra.Alg.Term algebra.F.id_and ((algebra.Alg.Var 1)::(algebra.Alg.Var 2)::nil))::(algebra.Alg.Term algebra.F.id_xor ((algebra.Alg.Var 1)::(algebra.Alg.Term algebra.F.id_true nil)::nil))::nil)))::R_xml_0_rule_as_list_0. Definition R_xml_0_rule_as_list_2 := ((algebra.Alg.Term algebra.F.id_or ((algebra.Alg.Var 1):: (algebra.Alg.Var 2)::nil)), (algebra.Alg.Term algebra.F.id_xor ((algebra.Alg.Term algebra.F.id_and ((algebra.Alg.Var 1)::(algebra.Alg.Var 2)::nil))::(algebra.Alg.Term algebra.F.id_xor ((algebra.Alg.Var 1)::(algebra.Alg.Var 2)::nil))::nil))):: R_xml_0_rule_as_list_1. Definition R_xml_0_rule_as_list_3 := ((algebra.Alg.Term algebra.F.id__equal_ ((algebra.Alg.Var 1):: (algebra.Alg.Var 2)::nil)), (algebra.Alg.Term algebra.F.id_xor ((algebra.Alg.Var 1):: (algebra.Alg.Term algebra.F.id_xor ((algebra.Alg.Var 2):: (algebra.Alg.Term algebra.F.id_true nil)::nil))::nil))):: R_xml_0_rule_as_list_2. Definition R_xml_0_rule_as_list := R_xml_0_rule_as_list_3. 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.or5_equiv in H|-. case H;clear H;intros H. injection H;intros ;subst;constructor 4. injection H;intros ;subst;constructor 3. 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_3 (x4 x5 x6:Prop) : Prop := | conj_3 : x4->x5->x6->and_3 x4 x5 x6 . 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_3 (forall x5 x7, t = (algebra.Alg.Term algebra.F.id_and (x5::x7::nil)) -> exists x4, exists x6, t' = (algebra.Alg.Term algebra.F.id_and (x4::x6::nil))/\ (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) x4 x5)/\ (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) x6 x7)) (t = (algebra.Alg.Term algebra.F.id_true nil) -> t' = (algebra.Alg.Term algebra.F.id_true nil)) (forall x5 x7, t = (algebra.Alg.Term algebra.F.id_xor (x5::x7::nil)) -> exists x4, exists x6, t' = (algebra.Alg.Term algebra.F.id_xor (x4::x6::nil))/\ (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) x4 x5)/\ (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) x6 x7)). 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 x7 H;exists x5;exists x7;intuition;constructor 1. intros H;intuition;constructor 1. intros x5 x7 H;exists x5;exists x7;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_and H_id_true H_id_xor]. constructor. clear H_id_true H_id_xor;intros x5 x7 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_and y x7 (refl_equal _)) as [x4 [x6]];intros ;intuition; exists x4;exists x6;intuition; eapply closure_extension.refl_trans_clos_R;eassumption end . match goal with | H:algebra.EQT.one_step _ ?y x7 |- _ => destruct (H_id_and x5 y (refl_equal _)) as [x4 [x6]];intros ;intuition; exists x4;exists x6;intuition; eapply closure_extension.refl_trans_clos_R;eassumption end . clear H_id_and H_id_xor;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 ). clear H_id_and H_id_true;intros x5 x7 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_xor y x7 (refl_equal _)) as [x4 [x6]];intros ;intuition; exists x4;exists x6;intuition; eapply closure_extension.refl_trans_clos_R;eassumption end . match goal with | H:algebra.EQT.one_step _ ?y x7 |- _ => destruct (H_id_xor x5 y (refl_equal _)) as [x4 [x6]];intros ;intuition; exists x4;exists x6;intuition; eapply closure_extension.refl_trans_clos_R;eassumption end . Qed. Lemma id_and_is_R_xml_0_constructor : forall t t', (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) t' t) -> forall x5 x7, t = (algebra.Alg.Term algebra.F.id_and (x5::x7::nil)) -> exists x4, exists x6, t' = (algebra.Alg.Term algebra.F.id_and (x4::x6::nil))/\ (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) x4 x5)/\ (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) x6 x7). Proof. intros t t' H. destruct (are_constuctors_of_R_xml_0 H). assumption. Qed. Lemma id_true_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_true nil) -> t' = (algebra.Alg.Term algebra.F.id_true nil). Proof. intros t t' H. destruct (are_constuctors_of_R_xml_0 H). assumption. Qed. Lemma id_xor_is_R_xml_0_constructor : forall t t', (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) t' t) -> forall x5 x7, t = (algebra.Alg.Term algebra.F.id_xor (x5::x7::nil)) -> exists x4, exists x6, t' = (algebra.Alg.Term algebra.F.id_xor (x4::x6::nil))/\ (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) x4 x5)/\ (closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) x6 x7). 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_and (?x5::?x4::nil)) |- _ => let x5 := fresh "x" in (let x4 := fresh "x" in (let Heq := fresh "Heq" in (let Hred1 := fresh "Hred" in (let Hred2 := fresh "Hred" in (destruct (id_and_is_R_xml_0_constructor H (refl_equal _)) as [x5 [x4 [Heq [Hred2 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_true nil) |- _ => let Heq := fresh "Heq" in (set (Heq:=id_true_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 )) | H:closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) _ (algebra.Alg.Term algebra.F.id_xor (?x5::?x4::nil)) |- _ => let x5 := fresh "x" in (let x4 := fresh "x" in (let Heq := fresh "Heq" in (let Hred1 := fresh "Hred" in (let Hred2 := fresh "Hred" in (destruct (id_xor_is_R_xml_0_constructor H (refl_equal _)) as [x5 [x4 [Heq [Hred2 Hred1]]]]; (discriminate Heq)|| (injection Heq;intros ;subst;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_and (?x5::?x4::nil)) |- _ => let x5 := fresh "x" in (let x4 := fresh "x" in (let Heq := fresh "Heq" in (let Hred1 := fresh "Hred" in (let Hred2 := fresh "Hred" in (destruct (id_and_is_R_xml_0_constructor H (refl_equal _)) as [x5 [x4 [Heq [Hred2 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_true nil) |- _ => let Heq := fresh "Heq" in (set (Heq:=id_true_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 ))) | H:closure.refl_trans_clos (algebra.EQT.one_step R_xml_0_rules) _ (algebra.Alg.Term algebra.F.id_xor (?x5::?x4::nil)) |- _ => let x5 := fresh "x" in (let x4 := fresh "x" in (let Heq := fresh "Heq" in (let Hred1 := fresh "Hred" in (let Hred2 := fresh "Hred" in (destruct (id_xor_is_R_xml_0_constructor H (refl_equal _)) as [x5 [x4 [Heq [Hred2 Hred1]]]]; (discriminate Heq)|| (injection Heq;intros ;subst;clear Heq;clear H; try (simplify_star_reduction_R_xml_0 ))))))) end . End R_xml_0_deep_rew. Module WF_R_xml_0_deep_rew. Inductive DP_R_xml_0 : algebra.Alg.term ->algebra.Alg.term ->Prop := . 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. Lemma wf : well_founded WF_R_xml_0_deep_rew.DP_R_xml_0. Proof. constructor;intros _y _h;inversion _h;clear _h;subst; (R_xml_0_deep_rew.impossible_star_reduction_R_xml_0 )||(fail). 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___SK90___2.30.trs/a3pat.v" *** *** End: *** *)