Skip to content

Commit

Permalink
Merge branch 'master' into heapster-itree
Browse files Browse the repository at this point in the history
  • Loading branch information
RyanGlScott committed Dec 9, 2022
2 parents bbac0b2 + 06e4ee7 commit eabdf2d
Show file tree
Hide file tree
Showing 15 changed files with 588 additions and 155 deletions.
2 changes: 2 additions & 0 deletions heapster-saw/examples/arrays_proofs.v
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,7 @@ Proof.
there are multiple. For this poof though, it doesn't. *)
all: try assumption.
(* Proving that the loop invariant holds inductively: *)
- discriminate e_maybe.
- transitivity a2.
+ assumption.
+ apply isBvsle_suc_r; eauto.
Expand Down Expand Up @@ -251,6 +252,7 @@ Proof.
rewrite <- e_assuming; reflexivity.
- (* (e_if4 is a contradiction) *)
admit.
- admit.
- rewrite e_assuming.
change (intToBv 64 2) with (bvAdd 64 (intToBv 64 1) (intToBv 64 1)).
rewrite <- bvAdd_assoc.
Expand Down
2 changes: 1 addition & 1 deletion heapster-saw/examples/linked_list_proofs.v
Original file line number Diff line number Diff line change
Expand Up @@ -312,7 +312,7 @@ Section any.
(returnM (intToBv 64 0))
(fun y l' rec =>
f y >>= fun call_ret_val =>
if not (bvEq 64 call_ret_val (intToBv 64 0))
if negb (bvEq 64 call_ret_val (intToBv 64 0))
then returnM (intToBv 64 1) else rec).
Lemma any_fun_ref : refinesFun any any_fun.
Expand Down
1 change: 1 addition & 0 deletions saw-core-coq/.gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -3,3 +3,4 @@
*.v.d
*.vok
*.vos
.lia.cache
1 change: 1 addition & 0 deletions saw-core-coq/coq/_CoqProject
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ handwritten/CryptolToCoq/CompMExtra.v
handwritten/CryptolToCoq/CoqVectorsExtra.v
handwritten/CryptolToCoq/CryptolPrimitivesForSAWCoreExtra.v
handwritten/CryptolToCoq/SAWCoreBitvectors.v
handwritten/CryptolToCoq/SAWCoreBitvectorsZifyU64.v
handwritten/CryptolToCoq/SAWCorePrelude_proofs.v
handwritten/CryptolToCoq/SAWCorePreludeExtra.v
handwritten/CryptolToCoq/SAWCoreScaffolding.v
Expand Down
11 changes: 4 additions & 7 deletions saw-core-coq/coq/handwritten/CryptolToCoq/CompMExtra.v
Original file line number Diff line number Diff line change
Expand Up @@ -23,15 +23,12 @@ Tactic Notation "dependent" "destruction" ident(H) :=
(* match goal with H: _ |- _ => constr:(H) end. *)

Tactic Notation "unfold_projs" :=
unfold SAWCoreScaffolding.fst, SAWCoreScaffolding.snd;
cbn [ Datatypes.fst Datatypes.snd projT1 ].

Tactic Notation "unfold_projs" "in" constr(N) :=
unfold SAWCoreScaffolding.fst, SAWCoreScaffolding.snd in N;
cbn [ Datatypes.fst Datatypes.snd projT1 ] in N.

Tactic Notation "unfold_projs" "in" "*" :=
unfold SAWCoreScaffolding.fst, SAWCoreScaffolding.snd in *;
cbn [ Datatypes.fst Datatypes.snd projT1 ] in *.

Ltac split_prod_hyps :=
Expand Down Expand Up @@ -769,11 +766,11 @@ Hint Extern 999 (refinesFun _ _) => shelve : refinesFun.

Definition refinesFun_multiFixM_fst' lrt (F:lrtPi (LRT_Cons lrt LRT_Nil)
(lrtTupleType (LRT_Cons lrt LRT_Nil))) f
(ref_f:refinesFun (SAWCoreScaffolding.fst (F f)) f) :
(ref_f:refinesFun (fst (F f)) f) :
refinesFun (fst (multiFixM F)) f := refinesFun_multiFixM_fst lrt F f ref_f.

Definition refinesFun_fst lrt B f1 (fs:B) f2 (r:@refinesFun lrt f1 f2) :
refinesFun (SAWCoreScaffolding.fst (f1, fs)) f2 := r.
refinesFun (fst (f1, fs)) f2 := r.

Hint Resolve refinesFun_fst | 1 : refinesFun.
Hint Resolve refinesFun_multiFixM_fst' | 1 : refinesFun.
Expand Down Expand Up @@ -849,7 +846,7 @@ Ltac prove_refinement_core := prove_refinement_core with Default.
form` P |= Q`, where P,Q may contain matching calls to `letRecM`. *)

Tactic Notation "prove_refinement" "with" constr(opts) :=
unfold_projs; unfold Eq, Refl, SAWCoreScaffolding.Bool;
unfold_projs;
apply StartAutomation_fold;
prove_refinement_core with opts.

Expand Down Expand Up @@ -951,7 +948,7 @@ Module CompMExtraNotation.
Declare Scope fun_syntax.


Infix "&&" := SAWCoreScaffolding.and : fun_syntax.
Infix "&&" := andb : fun_syntax.
Infix "<=" := (SAWCoreVectorsAsCoqVectors.bvsle _) : fun_syntax.
Notation " a <P b" := (SAWCorePrelude.bvultWithProof _ a b) (at level 98) : fun_syntax.
Notation " a == b" := (SAWCorePrelude.bvEq _ a b) (at level 100) : fun_syntax.
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -18,11 +18,11 @@ Import ListNotations.
(** It is annoying to have to wrap natural numbers into [TCNum] to use them at
type [Num], so these coercions will do it for us.
*)
Coercion TCNum : Nat >-> Num.
Coercion TCNum : nat >-> Num.
Definition natToNat (n : nat) : Nat := n.
Coercion natToNat : nat >-> Nat.

Theorem Eq_TCNum a b : a = b -> Eq _ (TCNum a) (TCNum b).
Theorem Eq_TCNum a b : a = b -> eq (TCNum a) (TCNum b).
Proof.
intros EQ.
apply f_equal.
Expand Down
59 changes: 24 additions & 35 deletions saw-core-coq/coq/handwritten/CryptolToCoq/SAWCoreBitvectors.v
Original file line number Diff line number Diff line change
Expand Up @@ -83,7 +83,7 @@ Ltac compute_bv_funs_tac H t compute_bv_binrel compute_bv_binop

Ltac unfold_bv_funs := unfold bvNat, bvultWithProof, bvuleWithProof,
bvsge, bvsgt, bvuge, bvugt, bvSCarry, bvSBorrow,
xor, xorb.
xorb.

Tactic Notation "compute_bv_funs" :=
unfold_bv_funs;
Expand Down Expand Up @@ -354,15 +354,15 @@ Proof. holds_for_bits_up_to_3. Qed.
(** Lemmas about bitvector xor **)

Lemma bvXor_same n x :
SAWCorePrelude.bvXor n x x = SAWCorePrelude.replicate n Bool false.
SAWCorePrelude.bvXor n x x = SAWCorePrelude.replicate n bool false.
Proof.
unfold SAWCorePrelude.bvXor, SAWCorePrelude.bvZipWith, SAWCorePrelude.zipWith, SAWCorePrelude.replicate.
induction x; auto; simpl; f_equal; auto.
rewrite SAWCorePrelude.xor_same; auto.
Qed.

Lemma bvXor_zero n x :
SAWCorePrelude.bvXor n x (SAWCorePrelude.replicate n Bool false) = x.
SAWCorePrelude.bvXor n x (SAWCorePrelude.replicate n bool false) = x.
Proof.
unfold SAWCorePrelude.bvXor, SAWCorePrelude.bvZipWith, SAWCorePrelude.zipWith, SAWCorePrelude.replicate.
induction x; auto; simpl. f_equal; auto; cbn.
Expand All @@ -375,7 +375,7 @@ Lemma bvXor_assoc n x y z :
Proof.
unfold SAWCorePrelude.bvXor, SAWCorePrelude.bvZipWith, SAWCorePrelude.zipWith.
induction n; auto; simpl. f_equal; auto; cbn.
unfold xor. rewrite Bool.xorb_assoc_reverse. reflexivity.
rewrite Bool.xorb_assoc_reverse. reflexivity.
remember (S n).
destruct x; try solve [inversion Heqn0; clear Heqn0; subst]. injection Heqn0.
destruct y; try solve [inversion Heqn0; clear Heqn0; subst]. injection Heqn0.
Expand All @@ -388,7 +388,7 @@ Lemma bvXor_comm n x y :
Proof.
unfold SAWCorePrelude.bvXor, SAWCorePrelude.bvZipWith, SAWCorePrelude.zipWith.
induction n; auto; simpl. f_equal; auto; cbn.
unfold xor. apply Bool.xorb_comm.
apply Bool.xorb_comm.
remember (S n).
destruct x; try solve [inversion Heqn0; clear Heqn0; subst]. injection Heqn0.
destruct y; try solve [inversion Heqn0; clear Heqn0; subst]. injection Heqn0.
Expand All @@ -407,46 +407,46 @@ Proof. split; destruct a, b; easy. Qed.
Lemma boolEq_refl a : boolEq a a = true.
Proof. destruct a; easy. Qed.

Lemma and_bool_eq_true b c : and b c = true <-> (b = true) /\ (c = true).
Lemma and_bool_eq_true b c : andb b c = true <-> (b = true) /\ (c = true).
Proof.
split.
- destruct b, c; auto.
- intro; destruct H; destruct b, c; auto.
Qed.

Lemma and_bool_eq_false b c : and b c = false <-> (b = false) \/ (c = false).
Lemma and_bool_eq_false b c : andb b c = false <-> (b = false) \/ (c = false).
Proof.
split.
- destruct b, c; auto.
- intro; destruct H; destruct b, c; auto.
Qed.

Lemma or_bool_eq_true b c : or b c = true <-> (b = true) \/ (c = true).
Lemma or_bool_eq_true b c : orb b c = true <-> (b = true) \/ (c = true).
Proof.
split.
- destruct b, c; auto.
- intro; destruct H; destruct b, c; auto.
Qed.

Lemma or_bool_eq_false b c : or b c = false <-> (b = false) /\ (c = false).
Lemma or_bool_eq_false b c : orb b c = false <-> (b = false) /\ (c = false).
Proof.
split.
- destruct b, c; auto.
- intro; destruct H; destruct b, c; auto.
Qed.

Lemma not_bool_eq_true b : not b = true <-> b = false.
Lemma not_bool_eq_true b : negb b = true <-> b = false.
Proof. split; destruct b; auto. Qed.

Lemma not_bool_eq_false b : not b = false <-> b = true.
Lemma not_bool_eq_false b : negb b = false <-> b = true.
Proof. split; destruct b; auto. Qed.


(** Lemmas about bitvector equality **)

Lemma bvEq_cons w h0 h1 a0 a1 :
bvEq (S w) (VectorDef.cons _ h0 w a0) (VectorDef.cons _ h1 w a1) =
and (boolEq h0 h1) (bvEq w a0 a1).
andb (boolEq h0 h1) (bvEq w a0 a1).
Proof. reflexivity. Qed.

Lemma bvEq_refl w a : bvEq w a a = true.
Expand Down Expand Up @@ -485,13 +485,6 @@ Qed.

Hint Extern 1 (StartAutomation _) => progress compute_bv_funs: refinesFun.

Lemma true_eq_scaffolding_true : Datatypes.true = SAWCoreScaffolding.true.
Proof. reflexivity. Qed.
Lemma false_eq_scaffolding_false : Datatypes.false = SAWCoreScaffolding.false.
Proof. reflexivity. Qed.

Hint Rewrite true_eq_scaffolding_true false_eq_scaffolding_false : SAWCoreBitvectors_eqs.

Ltac FreshIntroArg_bv_eq T :=
let e := fresh in
IntroArg_intro e;
Expand Down Expand Up @@ -551,14 +544,14 @@ Proof. intros H eq; apply H; destruct b; easy. Qed.

Lemma IntroArg_and_bool_eq_true n (b c : bool) goal :
IntroArg n (b = true) (fun _ => FreshIntroArg n (c = true) (fun _ => goal)) ->
IntroArg n (and b c = true) (fun _ => goal).
IntroArg n (andb b c = true) (fun _ => goal).
Proof.
intros H eq; apply H; apply and_bool_eq_true in eq; destruct eq; eauto.
Qed.
Lemma IntroArg_and_bool_eq_false n (b c : bool) goal :
IntroArg n (b = false) (fun _ => goal) ->
IntroArg n (c = false) (fun _ => goal) ->
IntroArg n (and b c = false) (fun _ => goal).
IntroArg n (andb b c = false) (fun _ => goal).
Proof.
intros Hl Hr eq; apply and_bool_eq_false in eq.
destruct eq; [ apply Hl | apply Hr ]; eauto.
Expand All @@ -572,14 +565,14 @@ Qed.
Lemma IntroArg_or_bool_eq_true n (b c : bool) goal :
IntroArg n (b = true) (fun _ => goal) ->
IntroArg n (c = true) (fun _ => goal) ->
IntroArg n (or b c = true) (fun _ => goal).
IntroArg n (orb b c = true) (fun _ => goal).
Proof.
intros Hl Hr eq; apply or_bool_eq_true in eq.
destruct eq; [ apply Hl | apply Hr ]; eauto.
Qed.
Lemma IntroArg_or_bool_eq_false n (b c : bool) goal :
IntroArg n (b = false) (fun _ => FreshIntroArg n (c = false) (fun _ => goal)) ->
IntroArg n (or b c = false) (fun _ => goal).
IntroArg n (orb b c = false) (fun _ => goal).
Proof.
intros H eq; apply H; apply or_bool_eq_false in eq; destruct eq; eauto.
Qed.
Expand All @@ -591,11 +584,11 @@ Qed.

Lemma IntroArg_not_bool_eq_true n (b : bool) goal :
IntroArg n (b = false) (fun _ => goal) ->
IntroArg n (not b = true) (fun _ => goal).
IntroArg n (negb b = true) (fun _ => goal).
Proof. intros H eq; apply H, not_bool_eq_true; eauto. Qed.
Lemma IntroArg_not_bool_eq_false n (b : bool) goal :
IntroArg n (b = true) (fun _ => goal) ->
IntroArg n (not b = false) (fun _ => goal).
IntroArg n (negb b = false) (fun _ => goal).
Proof. intros H eq; apply H, not_bool_eq_false; eauto. Qed.

(* Hint Extern 1 (IntroArg _ (not _ = true) _) => *)
Expand Down Expand Up @@ -647,9 +640,9 @@ Hint Extern 1 (IntroArg _ (@eq bool ?x ?y) _) =>
lazymatch y with
| true => lazymatch x with
| SAWCorePrelude.bvEq _ _ _ => simple apply IntroArg_bvEq_eq
| and _ _ => simple apply IntroArg_and_bool_eq_true
| or _ _ => simple apply IntroArg_or_bool_eq_true
| not _ => simple apply IntroArg_not_bool_eq_true
| andb _ _ => simple apply IntroArg_and_bool_eq_true
| orb _ _ => simple apply IntroArg_or_bool_eq_true
| negb _ => simple apply IntroArg_not_bool_eq_true
| boolEq _ _ => simple apply IntroArg_boolEq_eq
| if _ then true else false => simple apply IntroArg_bool_eq_if_true
| if _ then 1%bool else 0%bool => simple apply IntroArg_bool_eq_if_true
Expand All @@ -658,9 +651,9 @@ Hint Extern 1 (IntroArg _ (@eq bool ?x ?y) _) =>
end
| false => lazymatch x with
| SAWCorePrelude.bvEq _ _ _ => simple apply IntroArg_bvEq_neq
| and _ _ => simple apply IntroArg_and_bool_eq_false
| or _ _ => simple apply IntroArg_or_bool_eq_false
| not _ => simple apply IntroArg_not_bool_eq_false
| andb _ _ => simple apply IntroArg_and_bool_eq_false
| orb _ _ => simple apply IntroArg_or_bool_eq_false
| negb _ => simple apply IntroArg_not_bool_eq_false
| boolEq _ _ => simple apply IntroArg_boolEq_neq
| if _ then true else false => simple apply IntroArg_bool_eq_if_false
| if _ then 1%bool else 0%bool => simple apply IntroArg_bool_eq_if_false
Expand Down Expand Up @@ -694,10 +687,6 @@ Proof. intros H eq; apply H; eauto. Qed.
Hint Extern 1 (IntroArg _ (iteDep (fun _ => Maybe (Eq _ _ _)) true _ _ = _) _) =>
simple apply IntroArg_iteDep_Maybe_Eq_true : refinesFun.
Hint Extern 1 (IntroArg _ (iteDep (fun _ => Maybe (Eq _ _ _)) false _ _ = _) _) =>
simple apply IntroArg_iteDep_Maybe_Eq_false : refinesFun.
Hint Extern 1 (IntroArg _ (iteDep (fun _ => Maybe (Eq _ _ _)) Datatypes.true _ _ = _) _) =>
simple apply IntroArg_iteDep_Maybe_Eq_true : refinesFun.
Hint Extern 1 (IntroArg _ (iteDep (fun _ => Maybe (Eq _ _ _)) Datatypes.false _ _ = _) _) =>
simple apply IntroArg_iteDep_Maybe_Eq_false : refinesFun.

Lemma IntroArg_isBvsle_def n w a b goal
Expand Down
Loading

0 comments on commit eabdf2d

Please sign in to comment.