Commit 69220d28 authored by charguer's avatar charguer

functorized_iris

parent 4632198a
......@@ -10,7 +10,7 @@ License: MIT.
*)
Set Implicit Arguments.
From Sep Require Import LambdaCF LambdaStruct.
From Sep Require Import LambdaCF LambdaStruct LambdaSepProofMode.
Import ProofMode.
Generalizable Variables A B.
......@@ -308,7 +308,7 @@ Proof using.
intros L. induction_wf: list_sub_wf L. intros p.
applys rule_app_fix=>//=. applys rule_if'.
- ram_apply rule_neq. auto with iFrame.
- unlock. xpull=>[= Hp]. rewrite true_eq_isTrue_eq in Hp.
- unlock. xpull ;=>[= Hp]. rewrite true_eq_isTrue_eq in Hp.
xchange (MList_not_null_inv_cons p); [by auto|]. xpull=>p' x L' ?. subst.
applys rule_let. { ram_apply rule_get_tl. auto with iFrame. }
unlock=> q /=. xpull=>->.
......
......@@ -1168,38 +1168,3 @@ Proof using.
Qed.
*)
(* ---------------------------------------------------------------------- *)
(** Proof mode definitions for LambdaSep *)
Module ProofMode.
Export SepBasicTactics.ProofMode.
Definition wp (t:trm) (Q:val->hprop) : hprop :=
Hexists H, H \* \[triple t H Q].
Lemma wp_equiv : forall t H Q,
triple t H Q <-> (H ==> wp t Q).
Proof using.
intros. unfold wp. iff M.
{ hsimpl. rew_heap~. }
{ applys~ rule_consequence (rm M). xpull~. }
Qed.
Instance triple_as_valid t H Q : AsValid (triple t H Q) (H - wp t Q).
Proof. rewrite /AsValid wp_equiv. apply as_valid. Qed.
Instance frame_wp p t R Φ Ψ :
( v, Frame p R (Φ v) (Ψ v)) Frame p R (wp t Φ) (wp t Ψ).
Proof.
rewrite /Frame /wp=> HR. iIntros "[HR H]". iDestruct "H" as (H) "[HH %]".
iExists (H ?p R)%I. iFrame. iPureIntro. eapply rule_frame_consequence=>//.
iIntros (?) "[??]". iApply HR. iFrame.
Qed.
Instance wp_absorbing t Q : Absorbing (wp t Q).
Proof.
apply wp_equiv. rewrite /bi_absorbingly -htop_True comm.
apply rule_htop_pre. iIntros "$".
Qed.
End ProofMode.
Set Implicit Arguments.
From Sep Require Import LambdaSep.
(* ---------------------------------------------------------------------- *)
(** Proof mode definitions for LambdaSep *)
Require Import SepGPM.
Module ProofMode.
Module SepBasicGPM := SepLogicGPM SepBasicCore SepBasicTactics.SS.
Export SepBasicGPM.ProofMode.
Definition wp (t:trm) (Q:val->hprop) : hprop :=
Hexists H, H \* \[triple t H Q].
Lemma wp_equiv : forall t H Q,
triple t H Q <-> (H ==> wp t Q).
Proof using.
intros. unfold wp. iff M.
{ hsimpl. rew_heap~. }
{ applys~ rule_consequence (rm M). xpull~. }
Qed.
Instance triple_as_valid t H Q : AsValid (triple t H Q) (H - wp t Q).
Proof. rewrite /AsValid wp_equiv. apply as_valid. Qed.
Instance frame_wp p t R Φ Ψ :
( v, Frame p R (Φ v) (Ψ v)) Frame p R (wp t Φ) (wp t Ψ).
Proof.
rewrite /Frame /wp=> HR. iIntros "[HR H]". iDestruct "H" as (H) "[HH %]".
iExists (H ?p R)%I. iFrame. iPureIntro. eapply rule_frame_consequence=>//.
iIntros (?) "[??]". iApply HR. iFrame.
Qed.
Instance wp_absorbing t Q : Absorbing (wp t Q).
Proof.
apply wp_equiv. rewrite /bi_absorbingly -htop_True comm.
apply rule_htop_pre. iIntros "$".
Qed.
(**--- TODO: factorize in SepGPM (with tactic rebinding?) *)
(* ProofMode's [iIntros] tend to move pure facts in Coq's context.
While, in general, this is desirable, this is not what we want
after having applied [local_ramified_frame] because we would loose
pure facts that will not be unified in [Q] when [Q] is an evar. As
a result, we use a specific version of this lemma where Q1 is
locked, and hence pure facts cannot escape.
This specific version is only used when the post-condition is
indeed an evar. *)
Lemma local_ramified_frame_locked {B} : forall (Q1 : B hprop) H1 F H Q,
is_local F ->
F H1 Q1 ->
H ==> H1 \* (locked Q1 \---* Q) ->
F H Q.
Proof using. unlock. apply local_ramified_frame. Qed.
Ltac ram_apply lem :=
lazymatch goal with
| |- ?F _ ?Q =>
(is_evar Q; eapply local_ramified_frame_locked) ||
eapply local_ramified_frame
end; [xlocal_core tt|eapply lem|iPrepare].
(* TODO: try to factorize this: *)
Ltac hpull_xpull_iris_hook tt ::=
unfold_proofmode.
End ProofMode.
......@@ -14,7 +14,7 @@ COQFLAGS:=-w -notation-overridden,-implicits-in-term
# Compilation.
# Note: double space below is important for export.sh
SRC := TLCbuffer Fmap SepFunctor SepTactics LambdaSemantics LambdaSep LambdaCF LambdaCFTactics LambdaStruct ExampleListProofMode LambdaSepRO ExampleROProofMode LambdaSepCredits LambdaSepLifted LambdaCFLifted LambdaStructLifted Example ExampleBasicNonlifted ExampleListNonlifted ExampleQueueNonlifted ExampleBasic ExampleTrees ExampleUnionFind ExampleHigherOrder ExampleList LambdaCFCredits ExampleRO ExampleListProofMode
SRC := TLCbuffer Fmap SepFunctor SepTactics SepGPM LambdaSemantics LambdaSep LambdaSepProofMode LambdaCF LambdaCFTactics LambdaStruct ExampleListProofMode LambdaSepRO ExampleROProofMode LambdaSepCredits LambdaSepLifted LambdaCFLifted LambdaStructLifted Example ExampleBasicNonlifted ExampleListNonlifted ExampleQueueNonlifted ExampleBasic ExampleTrees ExampleUnionFind ExampleHigherOrder ExampleList LambdaCFCredits ExampleRO ExampleListProofMode
# LambdaCFRO
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment