diff options
Diffstat (limited to 'src/spl')
| -rw-r--r-- | src/spl/Arithmetic.v | 18 | ||||
| -rw-r--r-- | src/spl/Assumptions.v | 14 | ||||
| -rw-r--r-- | src/spl/Operators.v | 67 | ||||
| -rw-r--r-- | src/spl/Syntactic.v | 110 |
4 files changed, 140 insertions, 69 deletions
diff --git a/src/spl/Arithmetic.v b/src/spl/Arithmetic.v index 8ec41ab..05c999d 100644 --- a/src/spl/Arithmetic.v +++ b/src/spl/Arithmetic.v @@ -1,13 +1,9 @@ (**************************************************************************) (* *) (* SMTCoq *) -(* Copyright (C) 2011 - 2016 *) +(* Copyright (C) 2011 - 2019 *) (* *) -(* Michaël Armand *) -(* Benjamin Grégoire *) -(* Chantal Keller *) -(* *) -(* Inria - École Polytechnique - Université Paris-Sud *) +(* See file "AUTHORS" for the list of authors *) (* *) (* This file is distributed under the terms of the CeCILL-C licence *) (* *) @@ -16,8 +12,6 @@ (*** Spl -- a small checker for simplifications ***) -(* Add LoadPath ".." as SMTCoq. *) -(* Add LoadPath "../lia" as SMTCoq.lia. *) Require Import List PArray Bool Int63 ZMicromega. Require Import Misc State SMT_terms. Require Lia. @@ -52,7 +46,7 @@ Section Arith. Section Valid. - Variables (t_i : array typ_eqb) + Variables (t_i : array SMT_classes.typ_compdec) (t_func : array (Atom.tval t_i)) (ch_atom : Atom.check_atom t_atom) (ch_form : Form.check_form t_form) @@ -60,12 +54,14 @@ Section Arith. Local Notation interp_form_hatom := (Atom.interp_form_hatom t_i t_func t_atom). + Local Notation interp_form_hatom_bv := + (Atom.interp_form_hatom_bv t_i t_func t_atom). Local Notation rho := - (Form.interp_state_var interp_form_hatom t_form). + (Form.interp_state_var interp_form_hatom interp_form_hatom_bv t_form). Let wf_rho : Valuation.wf rho. - Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form); auto. Qed. + Proof. destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form); auto. Qed. Hint Immediate wf_rho. diff --git a/src/spl/Assumptions.v b/src/spl/Assumptions.v index b3dee4b..b219da4 100644 --- a/src/spl/Assumptions.v +++ b/src/spl/Assumptions.v @@ -1,13 +1,9 @@ (**************************************************************************) (* *) (* SMTCoq *) -(* Copyright (C) 2011 - 2016 *) +(* Copyright (C) 2011 - 2019 *) (* *) -(* Michaël Armand *) -(* Benjamin Grégoire *) -(* Chantal Keller *) -(* *) -(* Inria - École Polytechnique - Université Paris-Sud *) +(* See file "AUTHORS" for the list of authors *) (* *) (* This file is distributed under the terms of the CeCILL-C licence *) (* *) @@ -78,17 +74,18 @@ End Checker. Section Checker_correct. - Variable t_i : array typ_eqb. + Variable t_i : array SMT_classes.typ_compdec. Variable t_func : array (Atom.tval t_i). Variable t_atom : array Atom.atom. Variable t_form : array Form.form. - Local Notation rho := (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form). + Local Notation rho := (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) t_form). Variable s : S.t. Hypothesis Hs : S.valid rho s. Hypothesis Ht3 : Valuation.wf (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) + (Atom.interp_form_hatom_bv t_i t_func t_atom) t_form). Lemma interp_check_clause c1 : forall c2, @@ -124,6 +121,7 @@ Section Checker_correct. Variable concl : C.t. Hypothesis p : interp_conseq_uf (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) + (Atom.interp_form_hatom_bv t_i t_func t_atom) t_form) prem concl. Lemma valid_check_hole: C.valid rho (check_hole s prem_id prem concl). diff --git a/src/spl/Operators.v b/src/spl/Operators.v index c597fe9..f0aba15 100644 --- a/src/spl/Operators.v +++ b/src/spl/Operators.v @@ -1,13 +1,9 @@ (**************************************************************************) (* *) (* SMTCoq *) -(* Copyright (C) 2011 - 2016 *) +(* Copyright (C) 2011 - 2019 *) (* *) -(* Michaël Armand *) -(* Benjamin Grégoire *) -(* Chantal Keller *) -(* *) -(* Inria - École Polytechnique - Université Paris-Sud *) +(* See file "AUTHORS" for the list of authors *) (* *) (* This file is distributed under the terms of the CeCILL-C licence *) (* *) @@ -16,8 +12,6 @@ (*** Spl -- a small checker for simplifications ***) -(* Add LoadPath ".." as SMTCoq. *) -(* Add LoadPath "../lia" as SMTCoq.lia. *) Require Import List PArray Bool Int63 ZMicromega. Require Import Misc State SMT_terms. @@ -171,9 +165,16 @@ Section Operators. (get_atom a = Atom.Abop (Atom.BO_eq A) x y \/ get_atom a = Atom.Abop (Atom.BO_eq A) y x))). Proof. - intros A dist diseq; unfold check_diseqs; rewrite andb_true_iff, PArray.forallb_spec, check_diseqs_complete_spec, length_mapi; split; intros [H1 H2]; split. - clear H2; intros i Hi; generalize (H1 _ Hi); rewrite get_mapi; auto; case_eq (Lit.is_pos (diseq .[ i])); try discriminate; intro Heq1; case_eq (get_form (Lit.blit (diseq .[ i]))); try discriminate; intros a Heq2; case_eq (get_atom a); try discriminate; intros [ | | | | | | |B]; try discriminate; intros h1 h2 Heq3; case_eq (Typ.eqb A B); try discriminate; change (Typ.eqb A B = true) with (is_true (Typ.eqb A B)); rewrite Typ.eqb_spec; intro; subst B; case_eq (h1 == h2); try discriminate; rewrite eqb_false_spec; intro H2; case_eq (check_in h1 dist); try discriminate; case_eq (check_in h2 dist); try discriminate; rewrite !check_in_spec; intros H3 H4 _; split; try discriminate; exists a; split; auto; exists h1, h2; repeat split; auto; rewrite <- In2_In; auto. - clear H1; intros x y Hxy; destruct (H2 _ _ Hxy) as [i [H1 H4]]; clear H2; rewrite get_mapi in H4; auto; exists i; split; auto; generalize H4; case_eq (Lit.is_pos (diseq .[ i])); intro Heq; try (intros [H|H]; discriminate); case_eq (get_form (Lit.blit (diseq .[ i]))); [intros a| | |intros a1 a2|intros a1|intros a1|intros a1|intros a1 a2|intros a1 a2|intros a1 a2 a3]; intro Heq2; try (intros [H|H]; discriminate); case_eq (get_atom a); [intros a1|intros a1 a2|intros [ | | | | | | |B] h1 h2|intros a1 a2|intros a1 a2]; intro Heq3; try (intros [H|H]; discriminate); case_eq (Typ.eqb A B); try (intros _ [H|H]; discriminate); change (Typ.eqb A B = true) with (is_true (Typ.eqb A B)); rewrite Typ.eqb_spec; intro; subst B; case_eq (h1 == h2); try (intros _ [H|H]; discriminate); rewrite eqb_false_spec; intro H10; case (check_in h1 dist); try (intros [H|H]; discriminate); case (check_in h2 dist); try (intros [H|H]; discriminate); simpl; intro H3; split; try discriminate; exists a; split; auto; destruct H3 as [H3|H3]; inversion H3; subst; auto. + intros A dist diseq; unfold check_diseqs; rewrite andb_true_iff, + PArray.forallb_spec, check_diseqs_complete_spec, length_mapi; split; intros [H1 H2]; split. + clear H2; intros i Hi; generalize (H1 _ Hi); rewrite get_mapi; + auto; case_eq (Lit.is_pos (diseq .[ i])); try discriminate; intro Heq1; case_eq (get_form (Lit.blit (diseq .[ i]))); + try discriminate; intros a Heq2; case_eq (get_atom a); try discriminate; intros [ | | | | | | | B | | | | | | | | | | | | | ]; try discriminate; intros h1 h2 Heq3; case_eq (Typ.eqb A B); try discriminate; change (Typ.eqb A B = true) with (is_true (Typ.eqb A B)); rewrite Typ.eqb_spec; intro; subst B; case_eq (h1 == h2); try discriminate; rewrite eqb_false_spec; intro H2; case_eq (check_in h1 dist); try discriminate; case_eq (check_in h2 dist); try discriminate; rewrite !check_in_spec; intros H3 H4 _; split; try discriminate; exists a; split; auto; exists h1, h2; repeat split; auto; rewrite <- In2_In; auto. + clear H1; intros x y Hxy; destruct (H2 _ _ Hxy) as [i [H1 H4]]; clear H2; rewrite get_mapi in H4; auto; exists i; split; auto; generalize H4; + + case_eq (Lit.is_pos (diseq .[ i])); intro Heq; try (intros [H|H]; discriminate); case_eq (get_form (Lit.blit (diseq .[ i]))); [intros a| | |intros a1 a2|intros a1|intros a1|intros a1|intros a1 a2|intros a1 a2| intros a1 a2 a3|intros a ls]; intro Heq2; try (intros [H|H]; discriminate); case_eq (get_atom a); [intros a1|intros a1 a2|intros [ | | | | | | | B | | | | | | | | | | | | | ] h1 h2|intros a1 a2|intros a1 a2 | intros a1 a2]; intro Heq3; try (intros [H|H]; discriminate); try (case_eq (Typ.eqb A B); try (intros _ [H|H]; discriminate); change (Typ.eqb A B = true) with (is_true (Typ.eqb A B)); rewrite Typ.eqb_spec; intro; subst B; case_eq (h1 == h2); try (intros _ [H|H]; discriminate); rewrite eqb_false_spec; intro H10; case (check_in h1 dist); try (intros [H|H]; discriminate); case (check_in h2 dist); try (intros [H|H]; discriminate); simpl; intro H3; split; try discriminate; exists a; split; auto; destruct H3 as [H3|H3]; inversion H3; subst; auto). +intros. destruct H0; now contradict H0. + clear H2; intros i Hi; rewrite get_mapi; auto; destruct (H1 _ Hi) as [H2 [a [H3 [h1 [h2 [H4 [H5 H6]]]]]]]; clear H1; replace (Lit.is_pos (diseq .[ i])) with false by (case_eq (Lit.is_pos (diseq .[ i])); auto); rewrite H3, H4, Typ.eqb_refl; simpl; replace (h1 == h2) with false by (case_eq (h1 == h2); auto; rewrite eqb_spec; intro H; elim H5; auto); simpl; rewrite <- In2_In, <- !check_in_spec in H6; auto; destruct H6 as [H6 H7]; rewrite H6, H7; auto. clear H1; intros x y Hxy; destruct (H2 _ _ Hxy) as [i [H1 [H3 [a [H4 [H6 H5]]]]]]; clear H2; exists i; split; auto; rewrite get_mapi; auto; replace (Lit.is_pos (diseq .[ i])) with false by (case_eq (Lit.is_pos (diseq .[ i])); auto); rewrite H4; assert (H7 := or_introl (In2 y x dist) Hxy); rewrite <- In2_In, <- !check_in_spec in H7; auto; destruct H7 as [H7 H8]; destruct H5 as [H5|H5]; rewrite H5, Typ.eqb_refl; [replace (x == y) with false by (case_eq (x == y); auto; rewrite eqb_spec; auto)|replace (y == x) with false by (case_eq (y == x); auto; rewrite eqb_spec; auto)]; simpl; rewrite H7, H8; auto. Qed. @@ -246,14 +247,14 @@ Section Operators. get_atom hb = Atom.Abop (Atom.BO_eq ty) y x). Proof. intros f1 f2; unfold check_distinct_two_args; split. - case (get_form f1); try discriminate; intro ha; case (get_form f2); try discriminate; intro hb; case_eq (get_atom ha); try discriminate; intros [A] [ |x [ |y [ |l]]] Heq1; try discriminate; case_eq (get_atom hb); try discriminate; intros [ | | | | | | |B] x' y' Heq2; try discriminate; rewrite !andb_true_iff, orb_true_iff, !andb_true_iff; change (Typ.eqb A B = true) with (is_true (Typ.eqb A B)); rewrite Typ.eqb_spec, !Int63Properties.eqb_spec; intros [H1 [[H2 H3]|[H2 H3]]]; subst B x' y'; exists ha, hb, A, x, y; auto. + case (get_form f1); try discriminate; intro ha; case (get_form f2); try discriminate; intro hb; case_eq (get_atom ha); try discriminate; intros [A] [ |x [ |y [ |l]]] Heq1; try discriminate; case_eq (get_atom hb); try discriminate; intros [ | | | | | | |B | | | | | | | | | | | | | ] x' y' Heq2; try discriminate; rewrite !andb_true_iff, orb_true_iff, !andb_true_iff; change (Typ.eqb A B = true) with (is_true (Typ.eqb A B)); rewrite Typ.eqb_spec, !Int63Properties.eqb_spec; intros [H1 [[H2 H3]|[H2 H3]]]; subst B x' y'; exists ha, hb, A, x, y; auto. intros [ha [hb [A [x [y [H1 [H2 [H3 [H4|H4]]]]]]]]]; rewrite H1, H2, H3, H4, Typ.eqb_refl, !eqb_refl; auto; rewrite orb_true_r; auto. Qed. Section Valid1. - Variables (t_i : array typ_eqb) + Variables (t_i : array SMT_classes.typ_compdec) (t_func : array (Atom.tval t_i)) (ch_atom : Atom.check_atom t_atom) (ch_form : Form.check_form t_form) @@ -261,8 +262,10 @@ Section Operators. Local Notation interp_form_hatom := (Atom.interp_form_hatom t_i t_func t_atom). + Local Notation interp_form_hatom_bv := + (Atom.interp_form_hatom_bv t_i t_func t_atom). Local Notation rho := - (Form.interp_state_var interp_form_hatom t_form). + (Form.interp_state_var interp_form_hatom interp_form_hatom_bv t_form). Let wf_t_atom : Atom.wf t_atom. Proof. destruct (Atom.check_atom_correct _ ch_atom); auto. Qed. @@ -271,10 +274,10 @@ Section Operators. Proof. destruct (Atom.check_atom_correct _ ch_atom); auto. Qed. Lemma default_t_form : default t_form = Ftrue. - Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [[H _] _]; auto. Qed. + Proof. destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form) as [[H _] _]; auto. Qed. Lemma wf_t_form : wf t_form. - Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [[_ H] _]; auto. Qed. + Proof. destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form) as [[_ H] _]; auto. Qed. Local Hint Immediate wf_t_atom default_t_atom default_t_form wf_t_form. @@ -354,7 +357,7 @@ Section Operators. | _, _ => false end. - Variables (t_i : array typ_eqb) + Variables (t_i : array SMT_classes.typ_compdec) (t_func : array (Atom.tval t_i)) (ch_atom : Atom.check_atom t_atom) (ch_form : Form.check_form t_form) @@ -362,8 +365,10 @@ Section Operators. Local Notation interp_form_hatom := (Atom.interp_form_hatom t_i t_func t_atom). + Local Notation interp_form_hatom_bv := + (Atom.interp_form_hatom_bv t_i t_func t_atom). Local Notation rho := - (Form.interp_state_var interp_form_hatom t_form). + (Form.interp_state_var interp_form_hatom interp_form_hatom_bv t_form). Hypothesis interp_check_var : forall x y, check_var x y -> Var.interp rho x = Var.interp rho y. @@ -395,9 +400,9 @@ Section Operators. Lemma interp_check_form_aux : forall a b, check_form_aux a b -> - Form.interp interp_form_hatom t_form a = Form.interp interp_form_hatom t_form b. + Form.interp interp_form_hatom interp_form_hatom_bv t_form a = Form.interp interp_form_hatom interp_form_hatom_bv t_form b. Proof. - intros [a| | |i1 l1|a1|a1|a1|l1 l2|l1 l2|l1 l2 l3] [b| | |j1 m1|a2|a2|a2|j1 j2|j1 j2|j1 j2 j3]; simpl; try discriminate;auto. + intros [a| | |i1 l1|a1|a1|a1|l1 l2|l1 l2|l1 l2 l3|a l1] [b| | |j1 m1|a2|a2|a2|j1 j2|j1 j2|j1 j2 j3|b m1]; simpl; try discriminate;auto. (* Atom *) unfold is_true; rewrite Int63Properties.eqb_spec; intro; subst a; auto. (* Interesting case *) @@ -485,7 +490,7 @@ Section Operators. Section Valid. - Variables (t_i : array typ_eqb) + Variables (t_i : array SMT_classes.typ_compdec) (t_func : array (Atom.tval t_i)) (ch_atom : Atom.check_atom t_atom) (ch_form : Form.check_form t_form) @@ -493,18 +498,20 @@ Section Operators. Local Notation interp_form_hatom := (Atom.interp_form_hatom t_i t_func t_atom). + Local Notation interp_form_hatom_bv := + (Atom.interp_form_hatom_bv t_i t_func t_atom). Local Notation rho := - (Form.interp_state_var interp_form_hatom t_form). + (Form.interp_state_var interp_form_hatom interp_form_hatom_bv t_form). Let wf_rho : Valuation.wf rho. - Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form); auto. Qed. + Proof. destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form); auto. Qed. Let default_t_form : default t_form = Ftrue. - Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [[H _] _]; auto. Qed. + Proof. destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form) as [[H _] _]; auto. Qed. Let wf_t_form : wf t_form. - Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [[_ H] _]; auto. Qed. + Proof. destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form) as [[_ H] _]; auto. Qed. Local Hint Immediate wf_rho default_t_form wf_t_form. @@ -522,7 +529,7 @@ Section Operators. Lemma interp_check_form : forall a b, check_form a b -> - Form.interp interp_form_hatom t_form a = Form.interp interp_form_hatom t_form b. + Form.interp interp_form_hatom interp_form_hatom_bv t_form a = Form.interp interp_form_hatom interp_form_hatom_bv t_form b. Proof. apply interp_check_form_aux, interp_check_hform; auto. Qed. @@ -547,3 +554,11 @@ Section Operators. End Valid. End Operators. + + + +(* + Local Variables: + coq-load-path: ((rec ".." "SMTCoq")) + End: +*) diff --git a/src/spl/Syntactic.v b/src/spl/Syntactic.v index 7a52694..cc34522 100644 --- a/src/spl/Syntactic.v +++ b/src/spl/Syntactic.v @@ -1,13 +1,9 @@ (**************************************************************************) (* *) (* SMTCoq *) -(* Copyright (C) 2011 - 2016 *) +(* Copyright (C) 2011 - 2019 *) (* *) -(* Michaël Armand *) -(* Benjamin Grégoire *) -(* Chantal Keller *) -(* *) -(* Inria - École Polytechnique - Université Paris-Sud *) +(* See file "AUTHORS" for the list of authors *) (* *) (* This file is distributed under the terms of the CeCILL-C licence *) (* *) @@ -15,9 +11,9 @@ (*** Spl -- a small checker for simplifications ***) - Require Import List PArray Bool Int63 ZMicromega. -Require Import Misc State SMT_terms. +Require Import Misc State SMT_terms BVList. +Require Lia. Local Open Scope array_scope. Local Open Scope int63_scope. @@ -29,7 +25,7 @@ Section CheckAtom. Import Atom. - Variable t_i : PArray.array typ_eqb. + Variable t_i : PArray.array SMT_classes.typ_compdec. Variable t_func : PArray.array (tval t_i). Variable t_atom : PArray.array atom. @@ -73,6 +69,8 @@ Section CheckAtom. Typ.eqb t1 t2 && ((check_hatom a1 b1 && check_hatom a2 b2) || (check_hatom a1 b2 && check_hatom a2 b1)) + | BO_BVand s1, BO_BVand s2 + | BO_BVor s1, BO_BVor s2 => N.eqb s1 s2 && check_hatom a1 b1 && check_hatom a2 b2 | _, _ => false end | Anop o1 l1, Anop o2 l2 => @@ -112,16 +110,62 @@ Section CheckAtom. Lemma check_atom_aux_correct : forall a1 a2, check_atom_aux a1 a2 -> interp t_i t_func t_atom a1 = interp t_i t_func t_atom a2. Proof. - intros [op1|op1 i1|op1 i1 j1|op1 li1|f1 args1]; simpl. + intros [op1|op1 i1|op1 i1 j1|op1 li1|op1 li1|f1 args1]; simpl. (* Constants *) - intros [op2|op2 i2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; pose (H:=reflect_cop_eqb op1 op2); inversion H; try discriminate; subst op1; auto. + - intros [op2|op2 i2|op2 i2 j2|op2 li2|op2 li2|f2 args2]; simpl; try discriminate; pose (H:=reflect_cop_eqb op1 op2); inversion H; try discriminate; subst op1; auto. (* Unary operators *) - intros [op2|op2 i2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; try (case op1; discriminate). + - + intros [op2|op2 i2|op2 i2 j2|op2 li2|op2 li2|f2 args2]; simpl; try discriminate; try (case op1; discriminate). case op1; case op2; try discriminate; try (unfold is_true; rewrite andb_true_iff; intros [_ H]; rewrite (check_hatom_correct _ _ H); auto). - case_eq (get_atom i2); try discriminate; intros [ | | | | ] i Heq H; try discriminate; simpl; unfold apply_unop; rewrite (check_hatom_correct _ _ H); unfold interp_hatom; rewrite (t_interp_wf _ _ _ Hwf Hd i2), Heq; simpl; unfold apply_unop; destruct (t_interp t_i t_func t_atom .[ i]) as [A v]; destruct (Typ.cast A Typ.Tpositive) as [k| ]; auto. - case_eq (get_atom i1); try discriminate; intros [ | | | | ] i Heq H; try discriminate; simpl; unfold apply_unop; rewrite <- (check_hatom_correct _ _ H); unfold interp_hatom; rewrite (t_interp_wf _ _ _ Hwf Hd i1), Heq; simpl; unfold apply_unop; destruct (t_interp t_i t_func t_atom .[ i]) as [A v]; destruct (Typ.cast A Typ.Tpositive) as [k| ]; auto. - (* Binary operators *) - intros [op2|op2 i2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; case op1; case op2; try discriminate; try (unfold is_true; rewrite andb_true_iff; intros [H1 H2]; rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2); auto). + + case_eq (get_atom i2); try discriminate; + intros [ | | | | | | | | i0 n0 n1| n i0| n i0] i Heq H; try discriminate; simpl; + unfold apply_unop; rewrite (check_hatom_correct _ _ H); + unfold interp_hatom; rewrite (t_interp_wf _ _ _ Hwf Hd i2), Heq; simpl; + unfold apply_unop; destruct (t_interp t_i t_func t_atom .[ i]) as [A v]; + destruct (Typ.cast A Typ.Tpositive) as [k| ]; auto. + case_eq (get_atom i1); try discriminate; + intros [ | | | | | | | | i0 n0 n1| n i0| n i0] i Heq H; try discriminate; simpl; + unfold apply_unop. rewrite <- (check_hatom_correct _ _ H); + unfold interp_hatom; rewrite (t_interp_wf _ _ _ Hwf Hd i1), Heq; simpl; + unfold apply_unop; destruct (t_interp t_i t_func t_atom .[ i]) as [A v]; + destruct (Typ.cast A Typ.Tpositive) as [k| ]; auto. + + intros n m n1 m2. simpl. unfold is_true. rewrite !andb_true_iff, beq_nat_true_iff, N.eqb_eq. intros [[-> ->] H]. rewrite (check_hatom_correct _ _ H); auto. + intros n m. simpl. unfold is_true. rewrite andb_true_iff, N.eqb_eq. intros [-> H]. rewrite (check_hatom_correct _ _ H); auto. + intros n m. simpl. unfold is_true. rewrite andb_true_iff, N.eqb_eq. intros [-> H]. rewrite (check_hatom_correct _ _ H); auto. + (* bv_extr *) + intros i n0 n1 i0 n2 n3. + unfold is_true. rewrite andb_true_iff. + intros. destruct H as (Ha, Hb). + inversion Ha. + rewrite !andb_true_iff in H0. + destruct H0 as ((H0a, H0b), H0c). + rewrite N.eqb_eq in H0a, H0b, H0c. + subst. + rewrite (check_hatom_correct _ _ Hb); auto. + (* bv_zextn *) + intros n i n0 i0. + unfold is_true. rewrite andb_true_iff. + intros. destruct H as (Ha, Hb). + inversion Ha. + rewrite !andb_true_iff in H0. + destruct H0 as (H0a, H0b). + rewrite N.eqb_eq in H0a, H0b. + subst. + rewrite (check_hatom_correct _ _ Hb); auto. + (* bv_sextn *) + intros n i n0 i0. + unfold is_true. rewrite andb_true_iff. + intros. destruct H as (Ha, Hb). + inversion Ha. + rewrite !andb_true_iff in H0. + destruct H0 as (H0a, H0b). + rewrite N.eqb_eq in H0a, H0b. + subst. + rewrite (check_hatom_correct _ _ Hb); auto. + (* Binary operators *) + - intros [op2|op2 i2|op2 i2 j2|op2 li2|op2 li2|f2 args2]; simpl; try discriminate; case op1; case op2; try discriminate; try (unfold is_true; rewrite andb_true_iff; intros [H1 H2]; rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2); auto). unfold is_true, interp_bop, apply_binop. rewrite orb_true_iff, !andb_true_iff. intros [[H1 H2]|[H1 H2]]; rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2); destruct (interp_hatom t_i t_func t_atom i2) as [A v1]; destruct (interp_hatom t_i t_func t_atom j2) as [B v2]; destruct (Typ.cast B Typ.TZ) as [k2| ]; destruct (Typ.cast A Typ.TZ) as [k1| ]; auto; rewrite Z.add_comm; reflexivity. unfold is_true, interp_bop, apply_binop. rewrite orb_true_iff, !andb_true_iff. intros [[H1 H2]|[H1 H2]]; rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2); destruct (interp_hatom t_i t_func t_atom i2) as [A v1]; destruct (interp_hatom t_i t_func t_atom j2) as [B v2]; destruct (Typ.cast B Typ.TZ) as [k2| ]; destruct (Typ.cast A Typ.TZ) as [k1| ]; auto; rewrite Z.mul_comm; reflexivity. unfold interp_bop, apply_binop; destruct (interp_hatom t_i t_func t_atom j2) as [B v2]; destruct (interp_hatom t_i t_func t_atom i2) as [A v1]; destruct (Typ.cast B Typ.TZ) as [k2| ]; destruct (Typ.cast A Typ.TZ) as [k1| ]; auto; rewrite Z.gtb_ltb; auto. @@ -129,10 +173,18 @@ Section CheckAtom. unfold interp_bop, apply_binop; destruct (interp_hatom t_i t_func t_atom j2) as [B v2]; destruct (interp_hatom t_i t_func t_atom i2) as [A v1]; destruct (Typ.cast B Typ.TZ) as [k2| ]; destruct (Typ.cast A Typ.TZ) as [k1| ]; auto; rewrite Z.geb_leb; auto. unfold interp_bop, apply_binop; destruct (interp_hatom t_i t_func t_atom j2) as [B v2]; destruct (interp_hatom t_i t_func t_atom i2) as [A v1]; destruct (Typ.cast B Typ.TZ) as [k2| ]; destruct (Typ.cast A Typ.TZ) as [k1| ]; auto; rewrite Z.gtb_ltb; auto. intros A B; unfold is_true; rewrite andb_true_iff, orb_true_iff; change (Typ.eqb B A = true) with (is_true (Typ.eqb B A)); rewrite Typ.eqb_spec; intros [H2 [H1|H1]]; subst B; rewrite andb_true_iff in H1; destruct H1 as [H1 H2]; rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2); auto; simpl; unfold apply_binop; destruct (interp_hatom t_i t_func t_atom j2) as [B v1]; destruct (interp_hatom t_i t_func t_atom i2) as [C v2]; destruct (Typ.cast B A) as [k1| ]; destruct (Typ.cast C A) as [k2| ]; auto; rewrite Typ.i_eqb_sym; auto. + intros s1 s2; unfold is_true; rewrite !andb_true_iff, N.eqb_eq; + intros [[-> H1] H2]; + now rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2). + intros s1 s2; unfold is_true; rewrite !andb_true_iff, N.eqb_eq; + intros [[-> H1] H2]; + now rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2). + (* Ternary operators *) + - intros. now contradict H. (* N-ary operators *) - intros [op2|op2 i2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; destruct op1 as [t1]; destruct op2 as [t2]; unfold is_true; rewrite andb_true_iff; change (Typ.eqb t1 t2 = true) with (is_true (Typ.eqb t1 t2)); rewrite Typ.eqb_spec; intros [H1 H2]; subst t2; rewrite (list_beq_compute_interp _ _ _ H2); auto. + - intros [op2|op2 i2|op2 i2 j2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; destruct op1 as [t1]; destruct op2 as [t2]; unfold is_true; rewrite andb_true_iff; change (Typ.eqb t1 t2 = true) with (is_true (Typ.eqb t1 t2)); rewrite Typ.eqb_spec; intros [H1 H2]; subst t2; rewrite (list_beq_compute_interp _ _ _ H2); auto. (* Application *) - intros [op2|op2 i2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; unfold is_true; rewrite andb_true_iff, Int63Properties.eqb_spec; intros [H2 H1]; subst f2; rewrite (list_beq_correct _ _ H1); auto. + - intros [op2|op2 i2|op2 i2 j2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; unfold is_true; rewrite andb_true_iff, Int63Properties.eqb_spec; intros [H2 H1]; subst f2; rewrite (list_beq_correct _ _ H1); auto. Qed. End AUX. @@ -233,7 +285,10 @@ Section CheckAtom. forall h1 h2, check_neg_hatom h1 h2 -> interp_form_hatom t_i t_func t_atom h1 = negb (interp_form_hatom t_i t_func t_atom h2). Proof. - unfold interp_form_hatom. intros Hwt H1 H2 h1 h2 H3. unfold interp_bool. generalize (check_neg_hatom_correct Hwt H1 H2 _ _ H3). case (interp_hatom t_i t_func t_atom h1). case (interp_hatom t_i t_func t_atom h2). simpl. intros [i| | | ] v1 [j| | | ] v2; intro H; inversion H. rewrite Typ.cast_refl. auto. + unfold interp_form_hatom. intros Hwt H1 H2 h1 h2 H3. unfold interp_bool. generalize (check_neg_hatom_correct Hwt H1 H2 _ _ H3). + case (interp_hatom t_i t_func t_atom h1). + case (interp_hatom t_i t_func t_atom h2). + simpl. intros [ |i| | | | ] v1 [ |j| | | | ] v2; intro H; inversion H. rewrite Typ.cast_refl. auto. Qed. End CheckAtom. @@ -344,6 +399,7 @@ Section FLATTEN. (** Correctness proofs *) Variable interp_atom : atom -> bool. + Variable interp_bvatom : atom -> forall s, BITVECTOR_LIST.bitvector s. Hypothesis default_thf : default t_form = Ftrue. Hypothesis wf_thf : wf t_form. Hypothesis check_atom_correct : @@ -351,10 +407,10 @@ Section FLATTEN. Hypothesis check_neg_atom_correct : forall a1 a2, check_neg_atom a1 a2 -> interp_atom a1 = negb (interp_atom a2). - Local Notation interp_var := (interp_state_var interp_atom t_form). + Local Notation interp_var := (interp_state_var interp_atom interp_bvatom t_form). Local Notation interp_lit := (Lit.interp interp_var). - Lemma interp_Fnot2 : forall i l, interp interp_atom t_form (Fnot2 i l) = interp_lit l. + Lemma interp_Fnot2 : forall i l, interp interp_atom interp_bvatom t_form (Fnot2 i l) = interp_lit l. Proof. intros i l;simpl;apply fold_ind;trivial. intros a;rewrite negb_involutive;trivial. @@ -366,14 +422,14 @@ Section FLATTEN. unfold remove_not;intros l. case_eq (get_form (Lit.blit l));intros;trivial. unfold Lit.interp, Var.interp. - rewrite (wf_interp_form interp_atom t_form default_thf wf_thf (Lit.blit l)), H, interp_Fnot2. + rewrite (wf_interp_form interp_atom interp_bvatom t_form default_thf wf_thf (Lit.blit l)), H, interp_Fnot2. destruct(Lit.is_pos l);trivial. rewrite Lit.is_pos_neg, Lit.blit_neg;unfold Lit.interp;destruct (Lit.is_pos i0);trivial. rewrite negb_involutive;trivial. Qed. Lemma get_and_correct : forall l args, get_and l = Some args -> - interp_lit l = interp interp_atom t_form (Fand args). + interp_lit l = interp interp_atom interp_bvatom t_form (Fand args). Proof. unfold get_and;intros l args. rewrite <- remove_not_correct;unfold Lit.interp;generalize (remove_not l). @@ -384,7 +440,7 @@ Section FLATTEN. Qed. Lemma get_or_correct : forall l args, get_or l = Some args -> - interp_lit l = interp interp_atom t_form (For args). + interp_lit l = interp interp_atom interp_bvatom t_form (For args). Proof. unfold get_or;intros l args. rewrite <- remove_not_correct;unfold Lit.interp;generalize (remove_not l). @@ -527,3 +583,9 @@ Section FLATTEN. Qed. End FLATTEN. + +(* + Local Variables: + coq-load-path: ((rec ".." "SMTCoq")) + End: +*) |