diff options
Diffstat (limited to 'common/Values.v')
| -rw-r--r-- | common/Values.v | 197 |
1 files changed, 197 insertions, 0 deletions
diff --git a/common/Values.v b/common/Values.v index f8a666c0..1d272932 100644 --- a/common/Values.v +++ b/common/Values.v @@ -89,6 +89,27 @@ Definition has_type (v: val) (t: typ) : Prop := | _, _ => False end. +Definition has_type_b (v: val) (t: typ) := + match v, t with + | Vundef, _ => true + | Vint _, Tint => true + | Vlong _, Tlong => true + | Vfloat _, Tfloat => true + | Vsingle _, Tsingle => true + | Vptr _ _, Tint => negb Archi.ptr64 + | Vptr _ _, Tlong => Archi.ptr64 + | (Vint _ | Vsingle _), Tany32 => true + | Vptr _ _, Tany32 => negb Archi.ptr64 + | _, Tany64 => true + | _, _ => false + end. + +Lemma has_type_b_correct: forall v t, + has_type_b v t = true <-> has_type v t. +Proof. + destruct v; destruct t; cbn; destruct Archi.ptr64; cbn; split; intros; auto; discriminate. +Qed. + Fixpoint has_type_list (vl: list val) (tl: list typ) {struct vl} : Prop := match vl, tl with | nil, nil => True @@ -1470,6 +1491,60 @@ Proof. assert (32 < Int.max_unsigned) by reflexivity. lia. Qed. +Theorem shrx1_shr: + forall x z, + shrx x (Vint (Int.repr 1)) = Some z -> + z = shr (add x (shru x (Vint (Int.repr 31)))) (Vint (Int.repr 1)). +Proof. + intros. destruct x; simpl in H; try discriminate. + change (Int.ltu (Int.repr 1) (Int.repr 31)) with true in H; simpl in H. + inversion_clear H. + simpl. + change (Int.ltu (Int.repr 31) Int.iwordsize) with true; simpl. + change (Int.ltu (Int.repr 1) Int.iwordsize) with true; simpl. + f_equal. + rewrite Int.shrx1_shr by reflexivity. + reflexivity. +Qed. + +Theorem shrx_shr_3: + forall n x z, + shrx x (Vint n) = Some z -> + z = (if Int.eq n Int.zero then x else + if Int.eq n Int.one + then shr (add x (shru x (Vint (Int.repr 31)))) (Vint Int.one) + else shr (add x (shru (shr x (Vint (Int.repr 31))) + (Vint (Int.sub (Int.repr 32) n)))) + (Vint n)). +Proof. + intros. destruct x; simpl in H; try discriminate. + destruct (Int.ltu n (Int.repr 31)) eqn:LT; inv H. + exploit Int.ltu_inv; eauto. change (Int.unsigned (Int.repr 31)) with 31; intros LT'. + predSpec Int.eq Int.eq_spec n Int.zero. +- subst n. unfold Int.shrx. rewrite Int.shl_zero. unfold Int.divs. change (Int.signed Int.one) with 1. + rewrite Z.quot_1_r. rewrite Int.repr_signed; auto. +- predSpec Int.eq Int.eq_spec n Int.one. + * subst n. simpl. + change (Int.ltu (Int.repr 31) Int.iwordsize) with true. simpl. + change (Int.ltu Int.one Int.iwordsize) with true. simpl. + f_equal. + apply Int.shrx1_shr. + reflexivity. + * clear H0. + simpl. change (Int.ltu (Int.repr 31) Int.iwordsize) with true. simpl. + replace (Int.ltu (Int.sub (Int.repr 32) n) Int.iwordsize) with true. simpl. + replace (Int.ltu n Int.iwordsize) with true. + f_equal; apply Int.shrx_shr_2; assumption. + symmetry; apply zlt_true. change (Int.unsigned n < 32); omega. + symmetry; apply zlt_true. unfold Int.sub. change (Int.unsigned (Int.repr 32)) with 32. + assert (Int.unsigned n <> 0). + { red; intros; elim H. + rewrite <- (Int.repr_unsigned n), H0. auto. } + rewrite Int.unsigned_repr. + change (Int.unsigned Int.iwordsize) with 32; omega. + assert (32 < Int.max_unsigned) by reflexivity. omega. +Qed. + Theorem or_rolm: forall x n m1 m2, or (rolm x n m1) (rolm x n m2) = rolm x n (Int.or m1 m2). @@ -1729,6 +1804,58 @@ Proof. assert (64 < Int.max_unsigned) by reflexivity. lia. Qed. +Theorem shrxl1_shrl: + forall x z, + shrxl x (Vint (Int.repr 1)) = Some z -> + z = shrl (addl x (shrlu x (Vint (Int.repr 63)))) (Vint (Int.repr 1)). +Proof. + intros. destruct x; simpl in H; try discriminate. + change (Int.ltu (Int.repr 1) (Int.repr 63)) with true in H; simpl in H. + inversion_clear H. + simpl. + change (Int.ltu (Int.repr 63) Int64.iwordsize') with true; simpl. + change (Int.ltu (Int.repr 1) Int64.iwordsize') with true; simpl. + f_equal. + rewrite Int64.shrx'1_shr' by reflexivity. + reflexivity. +Qed. + +Theorem shrxl_shrl_3: + forall n x z, + shrxl x (Vint n) = Some z -> + z = (if Int.eq n Int.zero then x else + if Int.eq n Int.one + then shrl (addl x (shrlu x (Vint (Int.repr 63)))) (Vint Int.one) + else shrl (addl x (shrlu (shrl x (Vint (Int.repr 63))) + (Vint (Int.sub (Int.repr 64) n)))) + (Vint n)). +Proof. + intros. destruct x; simpl in H; try discriminate. + destruct (Int.ltu n (Int.repr 63)) eqn:LT; inv H. + exploit Int.ltu_inv; eauto. change (Int.unsigned (Int.repr 63)) with 63; intros LT'. + predSpec Int.eq Int.eq_spec n Int.zero. +- subst n. unfold Int64.shrx'. rewrite Int64.shl'_zero. unfold Int64.divs. change (Int64.signed Int64.one) with 1. + rewrite Z.quot_1_r. rewrite Int64.repr_signed; auto. +- predSpec Int.eq Int.eq_spec n Int.one. + * subst n. simpl. + change (Int.ltu (Int.repr 63) Int64.iwordsize') with true. simpl. + change (Int.ltu Int.one Int64.iwordsize') with true. simpl. + f_equal. + apply Int64.shrx'1_shr'. + reflexivity. + * clear H0. +simpl. change (Int.ltu (Int.repr 63) Int64.iwordsize') with true. simpl. + replace (Int.ltu (Int.sub (Int.repr 64) n) Int64.iwordsize') with true. simpl. + replace (Int.ltu n Int64.iwordsize') with true. + f_equal; apply Int64.shrx'_shr_2; assumption. + symmetry; apply zlt_true. change (Int.unsigned n < 64); omega. + symmetry; apply zlt_true. unfold Int.sub. change (Int.unsigned (Int.repr 64)) with 64. + assert (Int.unsigned n <> 0). { red; intros; elim H. rewrite <- (Int.repr_unsigned n), H0. auto. } + rewrite Int.unsigned_repr. + change (Int.unsigned Int64.iwordsize') with 64; omega. + assert (64 < Int.max_unsigned) by reflexivity. omega. +Qed. + Theorem negate_cmp_bool: forall c x y, cmp_bool (negate_comparison c) x y = option_map negb (cmp_bool c x y). Proof. @@ -2507,6 +2634,55 @@ Qed. End VAL_INJ_OPS. +(* Specializations of cmpu_bool, cmpu, cmplu_bool, and cmplu for maximal pointer validity *) + +Definition mxcmpu_bool cmp v1 v2: option bool := + cmpu_bool (fun _ _ => true) cmp v1 v2. + +Lemma mxcmpu_bool_correct vptr (cmp: comparison) (v1 v2: val) b: + cmpu_bool vptr cmp v1 v2 = Some b + -> mxcmpu_bool cmp v1 v2 = Some b. +Proof. + intros; eapply cmpu_bool_lessdef; (econstructor 1 || eauto). +Qed. + +Definition mxcmpu cmp v1 v2 := of_optbool (mxcmpu_bool cmp v1 v2). + +Lemma mxcmpu_correct vptr (cmp: comparison) (v1 v2: val): + lessdef (cmpu vptr cmp v1 v2) (mxcmpu cmp v1 v2). +Proof. + unfold cmpu, mxcmpu. + remember (cmpu_bool _ cmp v1 v2) as ob. + destruct ob; simpl. + - erewrite mxcmpu_bool_correct; eauto. + econstructor. + - econstructor. +Qed. + +Definition mxcmplu_bool (cmp: comparison) (v1 v2: val) + := (cmplu_bool (fun _ _ => true) cmp v1 v2). + +Lemma mxcmplu_bool_correct vptr (cmp: comparison) (v1 v2: val) b: + (cmplu_bool vptr cmp v1 v2) = Some b + -> (mxcmplu_bool cmp v1 v2) = Some b. +Proof. + intros; eapply cmplu_bool_lessdef; (econstructor 1 || eauto). +Qed. + +Definition mxcmplu cmp v1 v2 := of_optbool (mxcmplu_bool cmp v1 v2). + +Lemma mxcmplu_correct vptr (cmp: comparison) (v1 v2: val): + lessdef (maketotal (cmplu vptr cmp v1 v2)) + (mxcmplu cmp v1 v2). +Proof. + unfold cmplu, mxcmplu. + remember (cmplu_bool _ cmp v1 v2) as ob. + destruct ob as [b|]; simpl. + - erewrite mxcmplu_bool_correct; eauto. + simpl. econstructor. + - econstructor. +Qed. + End Val. Notation meminj := Val.meminj. @@ -2600,3 +2776,24 @@ Proof. unfold compose_meminj; rewrite H1; rewrite H3; eauto. rewrite Ptrofs.add_assoc. decEq. unfold Ptrofs.add. apply Ptrofs.eqm_samerepr. auto with ints. Qed. + + +(** Particular cases of extensionality lemma *) + +Lemma cmpu_bool_valid_pointer_eq vptr1 vptr2 c v1 v2: + (forall (b : block) (z : Z), vptr1 b z = vptr2 b z) -> + Val.cmpu_bool vptr1 c v1 v2 = Val.cmpu_bool vptr2 c v1 v2. +Proof. + intros EQ; unfold Val.cmpu_bool; destruct v1; try congruence; + destruct v2; try congruence; + rewrite !EQ; auto. +Qed. + +Lemma cmplu_bool_valid_pointer_eq vptr1 vptr2 c v1 v2: + (forall (b : block) (z : Z), vptr1 b z = vptr2 b z) -> + Val.cmplu_bool vptr1 c v1 v2 = Val.cmplu_bool vptr2 c v1 v2. +Proof. + intros EQ; unfold Val.cmplu_bool; destruct v1; try congruence; + destruct v2; try congruence; + rewrite !EQ; auto. +Qed. |