Skip to content

Commit 6ffe4c2

Browse files
authored
Merge pull request #754 from PrincetonUniversity/issue745
closes #745
2 parents 6a597e0 + 6e2d5cd commit 6ffe4c2

File tree

1 file changed

+17
-12
lines changed

1 file changed

+17
-12
lines changed

floyd/entailer.v

Lines changed: 17 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -449,13 +449,17 @@ Ltac try_prove_it_now :=
449449
where B and D are easily provable, one wants to leave the
450450
goal A/\C.
451451
*)
452+
453+
Definition conjuncts_marker (P: Prop) : Prop := P.
454+
(* The purpose of this conjuncts marker is to try to address VST issue #745 *)
455+
452456
Lemma try_conjuncts_lem2: forall A B : Prop,
453457
B -> A -> (A /\ B).
454458
Proof. tauto. Qed.
455459

456460
Lemma try_conjuncts_lem: forall A B A' B' : Prop,
457-
(A -> A') -> (B -> B') -> (A /\ B -> A' /\ B').
458-
Proof. tauto. Qed.
461+
(conjuncts_marker A -> A') -> (conjuncts_marker B -> B') -> ((A /\ B) -> A' /\ B').
462+
Proof. unfold conjuncts_marker; tauto. Qed.
459463

460464
Lemma try_conjuncts_start: forall A B: Prop,
461465
(A -> B) -> (A -> B).
@@ -468,22 +472,23 @@ Ltac try_conjuncts_solver :=
468472
end.
469473

470474
Ltac try_conjuncts :=
471-
first [ simple eapply conj;
475+
first [ simple apply conj;
472476
[try_conjuncts_solver | try_conjuncts ]
473477
| simple eapply try_conjuncts_lem2;
474-
[try_conjuncts_solver | match goal with H:_ |- _ => apply H end ]
478+
[try_conjuncts_solver
479+
| match goal with H: conjuncts_marker _ |- _ => red in H; apply H end ]
475480
| simple eapply try_conjuncts_lem;
476481
[intro; try_conjuncts | intro; try_conjuncts
477-
|match goal with H:_ |- _ => apply H end ]
478-
| match goal with H:_ |- _ => instantiate (1:=True) in H;
482+
|match goal with H: conjuncts_marker _ |- _ => red in H; apply H end ]
483+
| match goal with H: conjuncts_marker _ |- _ => instantiate (1:=True) in H;
479484
try_conjuncts_solver
480485
end
481-
| match goal with H:_ |- _ => apply H end
486+
| match goal with H: conjuncts_marker _ |- _ => red in H; apply H end
482487
].
483488

484489
Lemma try_conjuncts_prop_and:
485490
forall {A}{NA: NatDed A} (S: A) (P P': Prop) Q,
486-
(P' -> P) ->
491+
(conjuncts_marker P' -> P) ->
487492
(S |-- !! P' && Q) ->
488493
S |-- !! P && Q.
489494
Proof. intros.
@@ -495,7 +500,7 @@ Qed.
495500

496501
Lemma try_conjuncts_prop:
497502
forall {A}{NA: NatDed A} (S: A) (P P': Prop),
498-
(P' -> P) ->
503+
(conjuncts_marker P' -> P) ->
499504
(S |-- !! P') ->
500505
S |-- !! P .
501506
Proof. intros.
@@ -535,7 +540,7 @@ Qed.
535540
Ltac clean_up_stackframe := idtac.
536541

537542
Lemma my_auto_lem:
538-
forall (P Q: Prop), (P -> Q) -> (P -> Q).
543+
forall (P Q: Prop), (conjuncts_marker P -> Q) -> (P -> Q).
539544
Proof. auto. Qed.
540545

541546
Ltac my_auto_iter H :=
@@ -545,7 +550,7 @@ Ltac my_auto_iter H :=
545550
[let H1 := fresh in intro H1; my_auto_iter H1
546551
|let H1 := fresh in intro H1; my_auto_iter H1
547552
| apply H ]
548-
| apply H
553+
| red in H (* remove conjuncts_marker*); apply H
549554
].
550555

551556
Ltac all_True := solve [repeat simple apply conj; simple apply Coq.Init.Logic.I].
@@ -557,7 +562,7 @@ Ltac my_auto_reiter :=
557562
[intro; my_auto_reiter
558563
|intro; my_auto_reiter
559564
|eassumption]
560-
|eassumption].
565+
|lazymatch goal with H: conjuncts_marker _ |- _ => red in H; apply H end].
561566

562567
Ltac my_auto :=
563568
repeat match goal with |- ?P -> _ => match type of P with Prop => intro end end;

0 commit comments

Comments
 (0)