LogrelCC.examples.stack
From LogrelCC Require Import prelude.
From LogrelCC Require Import lang rules_unary cl_rules.
From iris.proofmode Require Import tactics.
Section stack.
Context `{heapG Σ}.
Definition create_stack :=
Rec (Alloc (InjR Unit)).
Definition create_stack_val :=
RecV (Alloc (InjR Unit)).
Lemma create_stack_to_val : to_val create_stack = Some create_stack_val.
Proof. done. Qed.
Lemma create_stack_closed : ∀ f, create_stack.[f] = create_stack.
Proof. trivial. Qed.
Definition stack_pop l :=
Rec (Case (Load l)
(App (Rec (InjL (Fst (Var 2))))
(Store l.[ren (+1)] (Load (Snd (Var 0)))))
(InjR Unit)).
Definition stack_pop_val l :=
RecV (Case (Load l)
(App (Rec (InjL (Fst (Var 2))))
(Store l.[ren (+1)] (Load (Snd (Var 0)))))
(InjR Unit)).
Lemma stack_pop_to_val l : to_val (stack_pop l) = Some (stack_pop_val l).
Proof. done. Qed.
Lemma stack_pop_subst f l :
(stack_pop l).[f] = stack_pop l.[upn 2 f].
Proof. by unfold stack_pop; asimpl. Qed.
Lemma stack_pop_closed l :
∀ f, (∀ n, l.[upn n f] = l) → (stack_pop l).[f] = (stack_pop l).
Proof. intros f Hl. by rewrite stack_pop_subst Hl. Qed.
Definition stack_push l :=
Rec (Store l (InjL (Pair (Var 1) (Alloc (Load l))))).
Definition stack_push_val l :=
RecV (Store l (InjL (Pair (Var 1) (Alloc (Load l))))).
Lemma stack_push_to_val l : to_val (stack_push l) = Some (stack_push_val l).
Proof. done. Qed.
Lemma stack_push_subst f l :
(stack_push l).[f] = stack_push l.[upn 2 f].
Proof. by unfold stack_push; asimpl. Qed.
Lemma stack_push_closed l :
∀ f, (∀ n, l.[upn n f] = l) → (stack_push l).[f] = (stack_push l).
Proof. by intros f Hl; asimpl; rewrite !Hl. Qed.
Fixpoint is_stack (s : list val) (l : loc) : iProp Σ :=
match s with
| [] => (l ↦ᵢ (InjRV UnitV))%I
| x :: s' => (∃ l', l ↦ᵢ (InjLV (PairV x (LocV l'))) ∗ (is_stack s' l'))%I
end.
Lemma clwp_create_stack :
(CLWP (App create_stack Unit) {{ v, ∃ l, ⌜v = LocV l⌝ ∗ is_stack [] l }})%I.
Proof.
iApply clwp_rec; eauto; simpl; iNext.
iApply clwp_alloc; eauto; iNext.
iIntros (l) "Hl". iApply clwp_value; eauto.
Qed.
Lemma clwp_stack_pop_empty l :
is_stack [] l ⊢ CLWP (App (stack_pop (Loc l)) Unit)
{{ v, ⌜v = InjRV UnitV⌝ ∗ is_stack [] l }}.
Proof.
iIntros "Hs" => /=.
iApply clwp_rec; eauto; asimpl; iNext.
iApply (clwp_bind [CaseCtx _ _]).
iApply clwp_load.
iSplitR; last iFrame; iNext.
iIntros "Hl"; iFrame.
iApply clwp_value; eauto; simpl.
iApply clwp_case_injr; eauto; iNext; simpl.
iApply clwp_value; eauto.
Qed.
Lemma clwp_stack_pop_non_empty x s l :
is_stack (x :: s) l ⊢ CLWP (App (stack_pop (Loc l)) Unit)
{{ v, ⌜v = InjLV x⌝ ∗ is_stack s l }}.
Proof.
iIntros "Hs"; simpl.
iDestruct "Hs" as (l') "[Hl Hl']".
iApply clwp_rec; eauto; asimpl; iNext.
iApply (clwp_bind [CaseCtx _ _]).
iApply clwp_load; iSplitR "Hl"; last (by iFrame); iNext; iIntros "Hl".
iApply clwp_value; eauto. simpl.
iApply clwp_case_injl; simpl; eauto; iNext; simpl.
iApply (clwp_bind [LoadCtx; StoreRCtx (LocV _); AppRCtx (RecV _)]).
iApply clwp_snd; eauto. iNext.
iApply clwp_value; eauto; simpl.
iApply (clwp_bind [StoreRCtx (LocV _); AppRCtx (RecV _)]).
destruct s as [|y s]; simpl.
- iApply clwp_load; iSplitR "Hl'"; last (by iFrame); iNext; iIntros "Hl'".
iApply clwp_value; eauto.
iApply (clwp_bind [AppRCtx (RecV _)]).
iApply clwp_store; eauto;
iSplitR "Hl"; last (by iFrame); iNext; iIntros "Hl".
iApply clwp_value; eauto; simpl.
iApply clwp_rec; eauto; iNext; asimpl.
iApply (clwp_bind [InjLCtx]).
iApply clwp_fst; eauto; iNext.
iApply clwp_value; eauto; simpl.
iApply clwp_value; eauto.
- iDestruct "Hl'" as (l'') "[Hl' Hl'']".
iApply clwp_load; iSplitR "Hl'"; last (by iFrame); iNext; iIntros "Hl'".
iApply clwp_value; eauto.
iApply (clwp_bind [AppRCtx (RecV _)]).
iApply clwp_store; eauto using to_of_val;
iSplitR "Hl"; last (by iFrame); iNext; iIntros "Hl".
iApply clwp_value; eauto; simpl.
iApply clwp_rec; eauto; iNext; asimpl.
iApply (clwp_bind [InjLCtx]).
iApply clwp_fst; eauto; iNext.
iApply clwp_value; eauto; simpl.
iApply clwp_value; eauto.
iSplit; first done.
iExists l''; simpl; iFrame.
Qed.
Lemma clwp_stack_push x s l :
is_stack s l ⊢ CLWP (App (stack_push (Loc l)) (of_val x))
{{ v, ⌜v = UnitV⌝ ∗ is_stack (x :: s) l }}.
Proof.
iIntros "Hl"; simpl.
iApply clwp_rec; eauto using to_of_val; asimpl; iNext.
destruct s as [|y s]; simpl.
- iApply (clwp_bind [AllocCtx; PairRCtx _; InjLCtx; StoreRCtx (LocV _)]).
iApply clwp_load; iSplitR "Hl"; last (by iFrame); iNext; iIntros "Hl".
iApply clwp_value; eauto using to_of_val; simpl.
iApply (clwp_bind [PairRCtx _; InjLCtx; StoreRCtx (LocV _)]).
iApply clwp_alloc; eauto; iNext.
iIntros (l') "Hl'"; iApply clwp_value; eauto; simpl.
iApply clwp_store; eauto; simpl;
iFrame; iNext; iIntros "Hl".
iApply clwp_value; eauto.
iSplit; first done.
iExists l'; iFrame.
- iDestruct "Hl" as (l') "[Hl Hl']".
iApply (clwp_bind [AllocCtx; PairRCtx _; InjLCtx; StoreRCtx (LocV _)]).
iApply clwp_load; iSplitR "Hl"; last (by iFrame); iNext; iIntros "Hl".
iApply clwp_value; eauto; simpl.
iApply (clwp_bind [PairRCtx _; InjLCtx; StoreRCtx (LocV _)]).
iApply clwp_alloc; eauto. iNext.
iIntros (l'') "Hl''"; iApply clwp_value; eauto; simpl.
iApply clwp_store; eauto; simpl;
iFrame; iNext; iIntros "Hl".
iApply clwp_value; eauto.
iSplit; first done.
iExists l''; iFrame.
iExists l'; iFrame.
Qed.
End stack.
Typeclasses Opaque create_stack.
Typeclasses Opaque stack_pop.
Typeclasses Opaque stack_push.
Global Opaque create_stack.
Global Opaque stack_pop.
Global Opaque stack_push.
Typeclasses Opaque create_stack_val.
Typeclasses Opaque stack_pop_val.
Typeclasses Opaque stack_push_val.
Global Opaque create_stack_val.
Global Opaque stack_pop_val.
Global Opaque stack_push_val.
From LogrelCC Require Import lang rules_unary cl_rules.
From iris.proofmode Require Import tactics.
Section stack.
Context `{heapG Σ}.
Definition create_stack :=
Rec (Alloc (InjR Unit)).
Definition create_stack_val :=
RecV (Alloc (InjR Unit)).
Lemma create_stack_to_val : to_val create_stack = Some create_stack_val.
Proof. done. Qed.
Lemma create_stack_closed : ∀ f, create_stack.[f] = create_stack.
Proof. trivial. Qed.
Definition stack_pop l :=
Rec (Case (Load l)
(App (Rec (InjL (Fst (Var 2))))
(Store l.[ren (+1)] (Load (Snd (Var 0)))))
(InjR Unit)).
Definition stack_pop_val l :=
RecV (Case (Load l)
(App (Rec (InjL (Fst (Var 2))))
(Store l.[ren (+1)] (Load (Snd (Var 0)))))
(InjR Unit)).
Lemma stack_pop_to_val l : to_val (stack_pop l) = Some (stack_pop_val l).
Proof. done. Qed.
Lemma stack_pop_subst f l :
(stack_pop l).[f] = stack_pop l.[upn 2 f].
Proof. by unfold stack_pop; asimpl. Qed.
Lemma stack_pop_closed l :
∀ f, (∀ n, l.[upn n f] = l) → (stack_pop l).[f] = (stack_pop l).
Proof. intros f Hl. by rewrite stack_pop_subst Hl. Qed.
Definition stack_push l :=
Rec (Store l (InjL (Pair (Var 1) (Alloc (Load l))))).
Definition stack_push_val l :=
RecV (Store l (InjL (Pair (Var 1) (Alloc (Load l))))).
Lemma stack_push_to_val l : to_val (stack_push l) = Some (stack_push_val l).
Proof. done. Qed.
Lemma stack_push_subst f l :
(stack_push l).[f] = stack_push l.[upn 2 f].
Proof. by unfold stack_push; asimpl. Qed.
Lemma stack_push_closed l :
∀ f, (∀ n, l.[upn n f] = l) → (stack_push l).[f] = (stack_push l).
Proof. by intros f Hl; asimpl; rewrite !Hl. Qed.
Fixpoint is_stack (s : list val) (l : loc) : iProp Σ :=
match s with
| [] => (l ↦ᵢ (InjRV UnitV))%I
| x :: s' => (∃ l', l ↦ᵢ (InjLV (PairV x (LocV l'))) ∗ (is_stack s' l'))%I
end.
Lemma clwp_create_stack :
(CLWP (App create_stack Unit) {{ v, ∃ l, ⌜v = LocV l⌝ ∗ is_stack [] l }})%I.
Proof.
iApply clwp_rec; eauto; simpl; iNext.
iApply clwp_alloc; eauto; iNext.
iIntros (l) "Hl". iApply clwp_value; eauto.
Qed.
Lemma clwp_stack_pop_empty l :
is_stack [] l ⊢ CLWP (App (stack_pop (Loc l)) Unit)
{{ v, ⌜v = InjRV UnitV⌝ ∗ is_stack [] l }}.
Proof.
iIntros "Hs" => /=.
iApply clwp_rec; eauto; asimpl; iNext.
iApply (clwp_bind [CaseCtx _ _]).
iApply clwp_load.
iSplitR; last iFrame; iNext.
iIntros "Hl"; iFrame.
iApply clwp_value; eauto; simpl.
iApply clwp_case_injr; eauto; iNext; simpl.
iApply clwp_value; eauto.
Qed.
Lemma clwp_stack_pop_non_empty x s l :
is_stack (x :: s) l ⊢ CLWP (App (stack_pop (Loc l)) Unit)
{{ v, ⌜v = InjLV x⌝ ∗ is_stack s l }}.
Proof.
iIntros "Hs"; simpl.
iDestruct "Hs" as (l') "[Hl Hl']".
iApply clwp_rec; eauto; asimpl; iNext.
iApply (clwp_bind [CaseCtx _ _]).
iApply clwp_load; iSplitR "Hl"; last (by iFrame); iNext; iIntros "Hl".
iApply clwp_value; eauto. simpl.
iApply clwp_case_injl; simpl; eauto; iNext; simpl.
iApply (clwp_bind [LoadCtx; StoreRCtx (LocV _); AppRCtx (RecV _)]).
iApply clwp_snd; eauto. iNext.
iApply clwp_value; eauto; simpl.
iApply (clwp_bind [StoreRCtx (LocV _); AppRCtx (RecV _)]).
destruct s as [|y s]; simpl.
- iApply clwp_load; iSplitR "Hl'"; last (by iFrame); iNext; iIntros "Hl'".
iApply clwp_value; eauto.
iApply (clwp_bind [AppRCtx (RecV _)]).
iApply clwp_store; eauto;
iSplitR "Hl"; last (by iFrame); iNext; iIntros "Hl".
iApply clwp_value; eauto; simpl.
iApply clwp_rec; eauto; iNext; asimpl.
iApply (clwp_bind [InjLCtx]).
iApply clwp_fst; eauto; iNext.
iApply clwp_value; eauto; simpl.
iApply clwp_value; eauto.
- iDestruct "Hl'" as (l'') "[Hl' Hl'']".
iApply clwp_load; iSplitR "Hl'"; last (by iFrame); iNext; iIntros "Hl'".
iApply clwp_value; eauto.
iApply (clwp_bind [AppRCtx (RecV _)]).
iApply clwp_store; eauto using to_of_val;
iSplitR "Hl"; last (by iFrame); iNext; iIntros "Hl".
iApply clwp_value; eauto; simpl.
iApply clwp_rec; eauto; iNext; asimpl.
iApply (clwp_bind [InjLCtx]).
iApply clwp_fst; eauto; iNext.
iApply clwp_value; eauto; simpl.
iApply clwp_value; eauto.
iSplit; first done.
iExists l''; simpl; iFrame.
Qed.
Lemma clwp_stack_push x s l :
is_stack s l ⊢ CLWP (App (stack_push (Loc l)) (of_val x))
{{ v, ⌜v = UnitV⌝ ∗ is_stack (x :: s) l }}.
Proof.
iIntros "Hl"; simpl.
iApply clwp_rec; eauto using to_of_val; asimpl; iNext.
destruct s as [|y s]; simpl.
- iApply (clwp_bind [AllocCtx; PairRCtx _; InjLCtx; StoreRCtx (LocV _)]).
iApply clwp_load; iSplitR "Hl"; last (by iFrame); iNext; iIntros "Hl".
iApply clwp_value; eauto using to_of_val; simpl.
iApply (clwp_bind [PairRCtx _; InjLCtx; StoreRCtx (LocV _)]).
iApply clwp_alloc; eauto; iNext.
iIntros (l') "Hl'"; iApply clwp_value; eauto; simpl.
iApply clwp_store; eauto; simpl;
iFrame; iNext; iIntros "Hl".
iApply clwp_value; eauto.
iSplit; first done.
iExists l'; iFrame.
- iDestruct "Hl" as (l') "[Hl Hl']".
iApply (clwp_bind [AllocCtx; PairRCtx _; InjLCtx; StoreRCtx (LocV _)]).
iApply clwp_load; iSplitR "Hl"; last (by iFrame); iNext; iIntros "Hl".
iApply clwp_value; eauto; simpl.
iApply (clwp_bind [PairRCtx _; InjLCtx; StoreRCtx (LocV _)]).
iApply clwp_alloc; eauto. iNext.
iIntros (l'') "Hl''"; iApply clwp_value; eauto; simpl.
iApply clwp_store; eauto; simpl;
iFrame; iNext; iIntros "Hl".
iApply clwp_value; eauto.
iSplit; first done.
iExists l''; iFrame.
iExists l'; iFrame.
Qed.
End stack.
Typeclasses Opaque create_stack.
Typeclasses Opaque stack_pop.
Typeclasses Opaque stack_push.
Global Opaque create_stack.
Global Opaque stack_pop.
Global Opaque stack_push.
Typeclasses Opaque create_stack_val.
Typeclasses Opaque stack_pop_val.
Typeclasses Opaque stack_push_val.
Global Opaque create_stack_val.
Global Opaque stack_pop_val.
Global Opaque stack_push_val.