Skip to content

GitLab

Commit bfd313b7 authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

Move the symbolic executor to its own file, and do some renaming to be consistent with the paper.

parent 6e625cb3
Expand all Hide whitespace changes
Inline Side-by-side
_CoqProject
View file @ bfd313b7
......@@ -12,7 +12,8 @@ theories/c_translation/proofmode.v
theories/c_translation/translation.v
theories/vcgen/dcexpr.v
theories/vcgen/denv.v
theories/vcgen/vcgen.v
theories/vcgen/vcg.v
theories/vcgen/forward.v
theories/vcgen/proofmode.v
theories/vcgen/reification.v
theories/tests/basics.v
......
theories/vcgen/forward.v 0 → 100644
View file @ bfd313b7
From iris_c.c_translation Require Export translation.
From iris_c.vcgen Require Export denv.
From iris_c.lib Require Import Q.
Section forward.
Context `{amonadG Σ}.
(** Evaluation of simple expressions *)
Fixpoint dexpr_eval (de : dexpr) : option dval :=
match de with
| dEVal dv => Some dv
| dEVar x => None
| dEPair de1 de2 =>
dv1 ← dexpr_eval de1;
dv2 ← dexpr_eval de2;
Some (dPairV dv1 dv2)
| dEFst de =>
dv ← dexpr_eval de;
match dv with dPairV dv1 _ => Some dv1 | _ => None end
| dESnd de =>
dv ← dexpr_eval de;
match dv with dPairV _ dv2 => Some dv2 | _ => None end
| dENone => Some dNone
| dEUnknown _ => None
end.
(** Computes the framing for the resources, necessary for the safety of the
expression, and simulatenously computes the strongest postcondition based on that.
See `forward_aux_correct` and `forward_correct`. *)
Fixpoint forward_aux (E: known_locs) (n : nat) (ms : list denv)
(de : dcexpr) : option (list denv * denv * dval) :=
match de, n with
| _, O => None
| dCRet de, _ => dv ← dexpr_eval de; Some (ms, [], dv)
| dCSeqBind x de1 de2, S n =>
''(ms1, mNew1, dv1) ← forward_aux E n ms de1;
''(ms2, mNew2, dv2) ← forward_aux E n (denv_unlock mNew1 :: ms1) (dce_subst' E x dv1 de2);
''(ms3, mNew3) ← pop_stack ms2;
Some (ms3, denv_merge mNew2 mNew3, dv2)
| dCLoad de1, S n =>
''(ms1, mNew, dl) ← forward_aux E n ms de1;
i ← dloc_var_of_dval dl;
''(ms2, mNew2, q, dv) ← denv_delete_frac_2 i ms1 mNew;
Some (ms2, denv_insert i ULvl q dv mNew2, dv)
| dCStore de1 de2, S n =>
''(ms1, mNew1, dl) ← forward_aux E n ms de1;
i ← dloc_var_of_dval dl;
''(ms2, mNew2, dv) ← forward_aux E n ms1 de2;
''(ms3, mNew3, _) ← denv_delete_full_2 i ms2 (denv_merge mNew1 mNew2);
Some (ms3, denv_insert i LLvl 1%Q dv mNew3, dv)
| dCBinOp op de1 de2, S n =>
''(ms1, mNew1, dv1) ← forward_aux E n ms de1;
''(ms2, mNew2, dv2) ← forward_aux E n ms1 de2;
dv ← dcbin_op_eval E op dv1 dv2;
Some (ms2, denv_merge mNew1 mNew2, dv)
| dCPreBinOp op de1 de2, S n =>
''(ms1, mNew1, dl) ← forward_aux E n ms de1;
i ← dloc_var_of_dval dl;
''(ms2, mNew2, dv2) ← forward_aux E n ms1 de2;
''(ms3, mNew3, dv) ← denv_delete_full_2 i ms2 (denv_merge mNew1 mNew2);
dv3 ← dcbin_op_eval E op dv dv2;
Some (ms3, denv_insert i LLvl 1 dv3 mNew3, dv)
| dCUnOp op de, S n =>
''(ms1, mNew1, dv) ← forward_aux E n ms de;
dv' ← dun_op_eval E op dv;
Some (ms1, mNew1, dv')
| dCPar de1 de2, S n =>
''(ms1, mNew1, dv1) ← forward_aux E n ms de1;
''(ms2, mNew2, dv2) ← forward_aux E n ms1 de2;
Some (ms2, denv_merge mNew1 mNew2, (dPairV dv1 dv2))
| dCMutBind _ _ _, _ | dCAlloc _ _, _ | dCWhile _ _, _ | dCWhileV _ _, _
| dCCall _ _, _ | dCUnknown _, _ => None
end.
Definition forward (E: known_locs) (n : nat) (m : denv)
(de : dcexpr) : option (denv * denv * dval) :=
''(ms,mNew,dv) ← forward_aux E n [m] de;
''(_, m') ← pop_stack ms;
Some (m', mNew, dv).
Global Arguments forward _ _ !_ /.
End forward.
Section forward_spec.
Context `{amonadG Σ}.
Hint Extern 2 (_ `prefix_of` _) => etrans; [eassumption|].
Hint Extern 0 (0 < 1)%Q => reflexivity.
Hint Resolve dknown_bool_of_dval_correct.
Hint Resolve dloc_var_of_dval_wf dloc_var_of_dval_correct.
Hint Resolve denv_wf_1_stack_pop denv_wf_2_stack_pop.
Hint Resolve dun_op_eval_Some_wf dun_op_eval_correct.
Hint Resolve dcbin_op_eval_Some_wf dcbin_op_eval_correct.
Hint Resolve dce_subst_wf'.
Hint Resolve denv_wf_dval_wf_lookup.
Hint Resolve denv_wf_insert denv_wf_merge denv_wf_unlock.
Hint Resolve denv_wf_delete_full denv_wf_dval_wf_delete_full.
Hint Resolve denv_wf_1_delete_frac_2 denv_wf_2_delete_frac_2.
Hint Resolve denv_wf_frac_wf_delete_frac_2 denv_wf_dval_wf_delete_frac_2.
Hint Resolve denv_wf_1_delete_full_2 denv_wf_2_delete_full_2.
Hint Resolve denv_wf_dval_wf_delete_full_2.
Lemma dexpr_eval_wf E de dv :
dexpr_eval de = Some dv → dexpr_wf E de → dval_wf E dv.
Proof.
revert dv. induction de; intros; repeat (simplify_option_eq || case_match);
repeat match goal with
| H : ∀ _, _ |- _ => efeed specialize H; [done..|]
end; naive_solver.
Qed.
Hint Resolve dexpr_eval_wf.
Lemma forward_aux_length E de ms ms' mNew dv n :
forward_aux E n ms de = Some (ms', mNew, dv) → length ms = length ms'.
Proof.
revert de ms ms' mNew dv.
induction n as [|n IH]; intros [] **; repeat (simplify_option_eq || case_match);
repeat match goal with
| H : pop_stack ?ms = _|- _ => is_var ms; destruct ms
| H : denv_delete_frac_2 _ _ _ = _ |- _ => apply denv_length_delete_frac_2 in H
| H : denv_delete_full_2 _ _ _ = _ |- _ => apply denv_length_delete_full_2 in H
| H : forward_aux _ _ _ _ = _ |- _ => apply IH in H
end; simplify_eq/=; eauto with lia.
Qed.
Lemma denv_wf_all_wf_forward_aux E de ms ms' mNew dv n :
forward_aux E n ms de = Some (ms', mNew, dv) →
Forall (denv_wf E) ms → dcexpr_wf E de →
Forall (denv_wf E) ms' ∧ denv_wf E mNew ∧ dval_wf E dv.
Proof.
revert de ms ms' mNew dv. induction n; intros [] **;
repeat (case_match || simplify_option_eq); destruct_and?;
repeat match reverse goal with
| IH : ∀ _ _ _ _ _, forward_aux _ _ _ _ = Some _ → _,
H : forward_aux _ _ _ _ = Some _ |- _ =>
destruct (IH _ _ _ _ _ H) as (?&?&?); clear H; [by eauto..|]
end; split_and!; eauto 10.
Qed.
Lemma denv_wf_1_forward_aux E de ms ms' mNew dv n :
forward_aux E n ms de = Some (ms', mNew, dv) →
Forall (denv_wf E) ms → dcexpr_wf E de → Forall (denv_wf E) ms'.
Proof. intros; eapply denv_wf_all_wf_forward_aux; eauto. Qed.
Lemma denv_wf_2_forward_aux E de ms ms' mNew dv n :
forward_aux E n ms de = Some (ms', mNew, dv) →
Forall (denv_wf E) ms → dcexpr_wf E de → denv_wf E mNew.
Proof. intros; eapply denv_wf_all_wf_forward_aux; eauto. Qed.
Lemma denv_wf_dval_wf_forward_aux E de ms ms' mNew dv n :
forward_aux E n ms de = Some (ms', mNew, dv) →
Forall (denv_wf E) ms → dcexpr_wf E de → dval_wf E dv.
Proof. intros; eapply denv_wf_all_wf_forward_aux; eauto. Qed.
Hint Resolve denv_wf_1_forward_aux denv_wf_2_forward_aux denv_wf_dval_wf_forward_aux.
Lemma denv_wf_1_forward E de m m' mNew dv n :
forward E n m de = Some (m', mNew, dv) →
denv_wf E m → dcexpr_wf E de → denv_wf E m'.
Proof.
rewrite /forward. intros; repeat (case_match || simplify_option_eq); eauto.
Qed.
Lemma denv_wf_2_forward E de m m' mNew dv n :
forward E n m de = Some (m', mNew, dv) →
denv_wf E m → dcexpr_wf E de → denv_wf E mNew.
Proof.
rewrite /forward. intros; repeat (case_match || simplify_option_eq); eauto.
Qed.
Lemma denv_wf_dval_wf_forward E de m m' mNew dv n :
forward E n m de = Some (m', mNew, dv) →
denv_wf E m → dcexpr_wf E de → dval_wf E dv.
Proof.
rewrite /forward. intros; repeat (case_match || simplify_option_eq); eauto.
Qed.
Hint Resolve denv_wf_1_forward denv_wf_2_forward denv_wf_dval_wf_forward.
Lemma dexpr_eval_correct E de dv :
dexpr_eval de = Some dv →
WP dexpr_interp E de {{ v, ⌜v = dval_interp E dv⌝ }}%I.
Proof.
iIntros (Hde). iInduction de as [] "IH" forall (dv Hde); simplify_option_eq.
- by iApply wp_value.
- wp_bind (dexpr_interp E _).
iApply wp_wand; [by iApply "IH1"|iIntros (? ->)].
wp_bind (dexpr_interp E _).
iApply wp_wand; [by iApply "IH"|iIntros (? ->)]. by wp_pures.
- case_match; simplify_eq/=. wp_bind (dexpr_interp E _).
iApply wp_wand; [by iApply "IH"|iIntros (? ->)]. by wp_pures.
- case_match; simplify_eq/=. wp_bind (dexpr_interp E _).
iApply wp_wand; [by iApply "IH"|iIntros (? ->)]. by wp_pures.
- by wp_pures.
Qed.
Lemma forward_aux_correct E de ms ms' mNew dv R n :
forward_aux E n ms de = Some (ms', mNew, dv) →
Forall (denv_wf E) ms → dcexpr_wf E de →
denv_stack_interp E ms ms' (AWP dcexpr_interp E de @ R
{{ v, ⌜v = dval_interp E dv⌝ ∧ denv_interp E mNew }})%I.
Proof.
iIntros (Hsp Hms Hde).
iInduction n as [|n IH] "IH" forall (de ms ms' mNew dv Hsp Hms Hde).
{ by destruct de. }
destruct de; simplify_eq/=; destruct_and?.
- (* return *)
destruct (dexpr_eval _) as [dv1|] eqn:?; simplify_eq /=.
iApply denv_stack_interp_intro; iApply awp_ret.
iApply wp_wand; first by iApply dexpr_eval_correct.
iIntros (? ->). iSplit; first done. by rewrite /denv_interp.
- (* bind *)
destruct (forward_aux _ _ ms _) as [[[ms1 mNew1] dv1]|] eqn:?; simplify_eq /=.
destruct (forward_aux _ _ (_ :: _) _) as [[[ms2 mNew2] dv2]|] eqn:?; simplify_eq /=.
destruct ms2 as [|m2 ms2'] eqn:?; simplify_eq/=.
assert (denv_wf E m2 ∧ Forall (denv_wf E) ms') as [??].
{ apply (Forall_cons (denv_wf E)); eauto 10. }
iDestruct ("IH" $! _ ms with "[//] [//] [//]") as "H1".
iDestruct ("IH" $! _ (_ :: ms1) with "[//] [] []") as "H2 /="; eauto 10.
iDestruct (denv_stack_interp_trans with "H1 H2") as "H".
iApply (denv_stack_interp_wand with "H"); iIntros "[H1 H2]".
iApply a_seq_bind_spec. iApply (awp_wand with "H1"); iIntros (v1) "[-> Hm]".
iDestruct (denv_unlock_interp with "Hm") as "Hm"; iModIntro.
iDestruct ("H2" with "Hm") as "[Hm2 H]". rewrite -dcexpr_interp_subst'.
iApply (awp_wand with "H"); iIntros (v2) "[-> Hm]".
iSplit; first done. iApply (denv_merge_interp with "[$]"); eauto 10.
- (* load *)
destruct (forward_aux _ _ _ _) as [[[ms1 mNew1] dv1]|] eqn:?; simplify_eq /=.
destruct (dloc_var_of_dval _) as [i|] eqn:?; simplify_eq/=.
destruct (denv_delete_frac_2 i _ _) as [[[[ms2 mNew2] q] dv2]|] eqn:?; simplify_eq/=.
iDestruct ("IH" $! _ ms with "[//] [//] [//]") as "H".
iDestruct (denv_stack_interp_trans with "H []") as "H".
{ iApply denv_delete_frac_2_interp; eauto. }
iApply (denv_stack_interp_wand with "H"); iIntros "[H1 H2]".
iApply a_load_spec. iApply (awp_wand with "H1"); iIntros (v1) "[-> Hm]".
iDestruct ("H2" with "Hm") as "[Hm2 Hi]".
iExists _, _. iFrame "Hi". iSplit; first by eauto.
iIntros "Hi"; iSplit; first done.
iApply denv_insert_interp; eauto with iFrame.
- (* assign *)
destruct (forward_aux _ _ _ _) as [[[ms1 mNew1] dv1]|] eqn:?; simplify_eq /=.
destruct (dloc_var_of_dval _) as [i|] eqn:?; simplify_eq/=.
destruct (forward_aux _ _ ms1 _) as [[[ms2 mNew2] dv2]|] eqn:?; simplify_eq /=.
destruct (denv_delete_full_2 i ms2 _) as [[[ms3 mNew3] dv3]|] eqn:?; simplify_eq/=.
iDestruct ("IH" $! _ ms with "[//] [//] [//]") as "H1".
iDestruct ("IH" $! _ ms1 with "[//] [] []") as "H2 /="; eauto 10.
iDestruct (denv_stack_interp_trans with "H1 H2") as "H".
iDestruct (denv_stack_interp_trans with "H []") as "H".
{ iApply denv_delete_full_2_interp; eauto. }
iApply (denv_stack_interp_wand with "H"); iIntros "[[H1 H2] H]".
iApply (a_store_spec with "H1 H2").
iIntros (v1 v2) "[-> Hm1] [-> Hm2]".
iDestruct ("H" with "[Hm1 Hm2]") as "[Hm Hi]".
{ iApply denv_merge_interp; eauto with iFrame. }
iExists _, _. iFrame "Hi". iSplit; first by eauto.
iIntros "Hi"; iSplit; first done.
iApply denv_insert_interp; eauto 10 with iFrame.
- (* bin op *)
destruct (forward_aux _ _ ms _) as [[[ms1 mNew1] dv1]|] eqn:?; simplify_eq /=.
destruct (forward_aux _ _ ms1 _) as [[[ms2 mNew2] dv2]|] eqn:Hsp2; simplify_eq /=.
destruct (dcbin_op_eval _ _ _ _) eqn:?; simplify_eq/=.
iDestruct ("IH" $! _ ms with "[//] [//] [//]") as "H1".
iDestruct ("IH" $! _ ms1 with "[//] [] []") as "H2 /="; eauto 10.
iDestruct (denv_stack_interp_trans with "H1 H2") as "H".
iApply (denv_stack_interp_wand with "H"); iIntros "[H1 H2]".
iApply (a_bin_op_spec with "H1 H2"); iIntros (v1 v2) "[-> Hm1] [-> Hm2]".
iExists _. repeat (iSplit; first by eauto).
iApply denv_merge_interp; eauto 10 with iFrame.
- (* pre bin op *)
destruct (forward_aux _ _ ms _) as [[[ms1 mNew1] dv1]|] eqn:?; simplify_eq /=.
destruct (dloc_var_of_dval _) as [i|] eqn:?; simplify_eq/=.
destruct (forward_aux _ _ ms1 _) as [[[ms2 mNew2] dv2]|] eqn:?; simplify_eq /=.
destruct (denv_delete_full_2 i ms2 _)
as [[[ms3 mNew3] dv'] |] eqn:?; simplify_eq/=.
destruct (dcbin_op_eval _ _ _ _) eqn:?; simplify_eq/=.
iDestruct ("IH" $! _ ms with "[//] [//] [//]") as "H1".
iDestruct ("IH" $! _ ms1 with "[//] [] []") as "H2 /="; eauto 10.
iDestruct (denv_stack_interp_trans with "H1 H2") as "H".
iDestruct (denv_stack_interp_trans with "H []") as "H".
{ iApply denv_delete_full_2_interp; eauto. }
iApply (denv_stack_interp_wand with "H"); iIntros "[[H1 H2] H]".
iApply (a_pre_bin_op_spec with "H1 H2").
iIntros (v1 v2) "[-> Hm1] [-> Hm2]".
iDestruct ("H" with "[Hm1 Hm2]") as "[Hm Hi]".
{ iApply denv_merge_interp; eauto with iFrame. }
iExists _, _, _. iFrame "Hi". repeat (iSplit; first by eauto).
iIntros "Hi"; iSplit; first done.
iApply denv_insert_interp; eauto 10 with iFrame.
- (* un op *)
destruct (forward_aux _ _ ms _) as [[[ms1 mNew1] dv1]|] eqn:?; simplify_eq /=.
destruct (dun_op_eval _ _ _) as [dw|] eqn:?; simplify_eq/=.
iDestruct ("IH" $! _ ms with "[//] [//] [//]") as "H".
iApply (denv_stack_interp_wand with "H"); iIntros "H".
iApply a_un_op_spec. iApply (awp_wand with "H"); iIntros (v1) "[-> $]"; eauto.
- (* par *)
destruct (forward_aux _ _ ms _) as [[[ms1 mNew1] dv1]|] eqn:?; simplify_eq /=.
destruct (forward_aux _ _ ms1 _) as [[[ms2 mNew2] dv2]|] eqn:?; simplify_eq /=.
iDestruct ("IH" $! _ ms with "[//] [//] [//]") as "H1".
iDestruct ("IH" $! _ ms1 with "[//] [] []") as "H2 /="; eauto 10.
iDestruct (denv_stack_interp_trans with "H1 H2") as "H".
iApply (denv_stack_interp_wand with "H"); iIntros "[H1 H2]".
iApply (awp_par with "H1 H2"); iIntros "!>" (v1 v2) "[-> Hm1] [-> Hm2] !>".
iSplit; first done. iApply denv_merge_interp; eauto 10 with iFrame.
Qed.
Lemma forward_correct E de m m' mNew dv R n :
forward E n m de = Some (m', mNew, dv) →
denv_wf E m → dcexpr_wf E de →
denv_interp E m -∗
denv_interp E m' ∗ AWP dcexpr_interp E de @ R {{ v,
⌜v = dval_interp E dv⌝ ∧ denv_interp E mNew }}.
Proof.
rewrite /forward. iIntros (Hsp Hwfm Hwf) "Hm".
destruct (forward_aux E n [m] de) as [[[ms ?mNew] ?dv]|] eqn:Hsp'; simplify_eq/=.
destruct ms as [|m'' ms]; simplify_eq/=.
pose proof (forward_aux_length _ _ _ _ _ _ _ Hsp'); destruct ms; simplify_eq/=.
iDestruct (forward_aux_correct _ _ [_] [_] with "Hm") as "[$$]"; eauto.
Qed.
End forward_spec.
theories/vcgen/proofmode.v
View file @ bfd313b7
From iris_c.c_translation Require Export translation.
From iris_c.vcgen Require Import vcgen denv reification.
From iris_c.vcgen Require Import vcg denv reification.
From iris.proofmode Require Import environments coq_tactics.
Import env_notations.
......@@ -88,7 +88,7 @@ Section tactics.
Lemma tac_vcg E1 E2 Γp Γs_in Γs_out m c e de R Φ :
IntoDEnv [] E1 Γs_in Γs_out m →
IntoDCExpr E1 E2 e de →
envs_entails (Envs Γp Γs_out c) (vcg_wp_while E2 (dcexpr_size de) m de R
envs_entails (Envs Γp Γs_out c) (vcg_while E2 (dcexpr_size de) m de R
(λ E3 m dv, wand_denv_interp E3 m (Φ (dval_interp E3 dv)))) →
envs_entails (Envs Γp Γs_in c) (AWP e @ R {{ Φ }}).
Proof.
......@@ -99,9 +99,9 @@ Section tactics.
iDestruct (Hentails with "[$HΓs $HΓp]") as "HΓs".
{ iPureIntro; constructor; naive_solver. }
iApply (awp_wand with "[-]").
{ iApply (vcg_wp_while_correct with "[Hm] HΓs"); eauto using denv_wf_mono.
{ iApply (vcg_while_correct with "[Hm] HΓs"); eauto using denv_wf_mono.
iApply (denv_interp_mono with "Hm"); eauto. }
rewrite /vcg_wp_continuation. iIntros (v) "H".
rewrite /vcg_continuation. iIntros (v) "H".
iDestruct "H" as (E3 dv m' -> ???) "[Hm HΦ]".
by iApply (wand_denv_interp_spec with "HΦ").
Qed.
......@@ -110,7 +110,7 @@ Section tactics.
IntoDEnv E1 E2 Γs_in Γs_out m →
IntoDVal E2 E3 v dv →
envs_entails (Envs Γp Γs_out c) (Φ E3 m dv) →
envs_entails (Envs Γp Γs_in c) (vcg_wp_continuation E1 Φ v).
envs_entails (Envs Γp Γs_in c) (vcg_continuation E1 Φ v).
Proof.
intros [HΓ ????] [-> ??]; rewrite !envs_entails_eq /= /of_envs.
iIntros (Hentails) "(Hwf & #HΓp & HΓs)".
......@@ -124,7 +124,7 @@ Section tactics.
End tactics.
(* Make sure users do not see auxiliary junk *)
Arguments vcg_wp_continuation {_ _ _ _}.
Arguments vcg_continuation {_ _ _ _}.
Ltac vcg :=
iStartProof;
......
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