Commit 823e05c0 authored by Dan Frumin's avatar Dan Frumin

Basic infrastructure for the new vcgen

parent 1e024dfb
...@@ -10,6 +10,7 @@ theories/c_translation/proofmode.v ...@@ -10,6 +10,7 @@ theories/c_translation/proofmode.v
theories/c_translation/translation.v theories/c_translation/translation.v
theories/c_translation/derived.v theories/c_translation/derived.v
theories/vcgen/dcexpr.v theories/vcgen/dcexpr.v
theories/vcgen/splitenv.v
theories/vcgen/vcgen.v theories/vcgen/vcgen.v
# theories/vcgen/test.v # theories/vcgen/test.v
# theories/heap_lang_vcgen/dval.v # theories/heap_lang_vcgen/dval.v
......
From iris.heap_lang Require Export proofmode notation.
From iris.bi Require Import big_op.
Inductive dloc :=
| dLoc : nat dloc
| dLocUnknown : loc dloc.
Global Instance dloc_decision : EqDecision dloc.
Proof. solve_decision. Defined.
Inductive dbase_lit : Type :=
| dLitInt : Z dbase_lit
| dLitBool : bool dbase_lit
| dLitUnit : dbase_lit
| dLitLoc : dloc dbase_lit
| dLitUnknown : base_lit dbase_lit.
Global Instance dlit_decision : EqDecision dbase_lit.
Proof. solve_decision. Defined.
Inductive dval : Type :=
| dLitV : dbase_lit dval
| dValUnknown : val dval.
Inductive doption (A : Type) : Type :=
| dNone : doption A
| dSome : A doption A
| dUnknown : option A doption A.
Arguments dNone {_}.
Arguments dSome {_} _.
Arguments dUnknown {_} _.
Global Instance doption_fmap : FMap doption := λ A B f m,
match m with
| dNone => dNone
| dSome x => dSome (f x)
| dUnknown o => dUnknown (f <$> o)
end.
Definition dloc_interp (E : list loc) (dl : dloc) : loc :=
match dl with
| dLoc i => from_option id inhabitant (E !! i)
| dLocUnknown l => l
end.
Definition dbase_lit_interp (E : list loc) (l : dbase_lit) : base_lit :=
match l with
| dLitInt x => LitInt x
| dLitBool b => LitBool b
| dLitUnit => LitUnit
| dLitLoc dl => LitLoc (dloc_interp E dl)
| dLitUnknown l => l
end.
Definition dval_interp (E : list loc) (v : dval) : val :=
match v with
| dLitV l => LitV (dbase_lit_interp E l)
| dValUnknown v => v
end.
Fixpoint doption_interp {A} (mx : doption A) : option A :=
match mx with
| dNone => None
| dSome x => Some x
| dUnknown mx => mx
end.
Definition dbin_op_eval_int (op : bin_op) (n1 n2 : Z) : dbase_lit :=
match op with
| PlusOp => dLitInt (n1 + n2)
| MinusOp => dLitInt (n1 - n2)
| MultOp => dLitInt (n1 * n2)
| QuotOp => dLitInt (n1 `quot` n2)
| RemOp => dLitInt (n1 `rem` n2)
| AndOp => dLitInt (Z.land n1 n2)
| OrOp => dLitInt (Z.lor n1 n2)
| XorOp => dLitInt (Z.lxor n1 n2)
| ShiftLOp => dLitInt (n1 n2)
| ShiftROp => dLitInt (n1 n2)
| LeOp => dLitBool (bool_decide (n1 n2))
| LtOp => dLitBool (bool_decide (n1 < n2))
| EqOp => dLitBool (bool_decide (n1 = n2))
end.
Lemma dbin_op_eval_int_correct E op n1 n2 :
bin_op_eval_int op n1 n2 = dbase_lit_interp E (dbin_op_eval_int op n1 n2).
Proof. by destruct op. Qed.
Definition dbin_op_eval_bool
(op : bin_op) (b1 b2 : bool) : doption dbase_lit :=
match op with
| PlusOp | MinusOp | MultOp | QuotOp | RemOp => dNone (* Arithmetic *)
| AndOp => dSome (dLitBool (b1 && b2))
| OrOp => dSome (dLitBool (b1 || b2))
| XorOp => dSome (dLitBool (xorb b1 b2))
| ShiftLOp | ShiftROp => dNone (* Shifts *)
| LeOp | LtOp => dNone (* InEquality *)
| EqOp => dSome (dLitBool (bool_decide (b1 = b2)))
end.
Lemma dbin_op_eval_bool_correct E op b1 b2 w :
dbin_op_eval_bool op b1 b2 = dSome w
bin_op_eval_bool op b1 b2 = Some (dbase_lit_interp E w).
Proof. destruct op; simpl; try by inversion 1. Qed.
Definition dbin_op_eval
(E : list loc) (op : bin_op) (dv1 dv2 : dval) : doption dval :=
match dv1,dv2 with
| dValUnknown _, _ | _,dValUnknown _ =>
dUnknown
(dValUnknown <$> bin_op_eval op (dval_interp E dv1) (dval_interp E dv2))
| dLitV l1, dLitV l2 =>
if decide (op = EqOp)
then dSome $ dLitV $ dLitBool
$ bool_decide (dbase_lit_interp E l1 = dbase_lit_interp E l2)
else match l1, l2 with
| (dLitInt n1), (dLitInt n2) =>
dSome $ dLitV $ dbin_op_eval_int op n1 n2
| (dLitBool b1), (dLitBool b2) =>
dLitV <$> dbin_op_eval_bool op b1 b2
| dLitUnknown _, _ | _, dLitUnknown _ =>
dUnknown (dValUnknown <$>
bin_op_eval op (dval_interp E dv1) (dval_interp E dv2))
| _, _ => dNone
end
end.
Lemma dbin_op_eval_correct E op dv1 dv2 w :
doption_interp (dbin_op_eval E op dv1 dv2) = Some w
bin_op_eval op (dval_interp E dv1) (dval_interp E dv2) =
Some (dval_interp E w).
Proof.
destruct dv1 as [dl1 | v1].
- destruct dv2 as [dl2 | v2].
+ unfold bin_op_eval. simpl. case_decide; simplify_eq/=.
{ inversion 1. rewrite /bin_op_eval /=. f_equal. simplify_eq /=.
do 2 case_bool_decide; simplify_eq /=; eauto. destruct H0. done. }
{ rewrite /bin_op_eval; intros; destruct dl1, dl2;
rewrite /bin_op_eval_int /bin_op_eval_bool; simplify_eq /=; f_equal;
try (destruct op; done); simpl.
- rewrite /bin_op_eval in H0; case_decide; first done.
destruct b; simplify_eq /=; f_equal.
- destruct op; simplify_eq /=; try done.
- case_decide; first done. destruct b0; simplify_eq /=; f_equal.
destruct op; simplify_eq /=; try done.
- case_decide; first done. destruct b; simplify_eq /=; f_equal.
- case_decide; first done; destruct b; simplify_eq /=; f_equal;
destruct op; simplify_eq /=; try done.
- case_decide; first done; destruct b; simplify_eq /=; f_equal.
- case_decide; first done; destruct b; simplify_eq /=; f_equal.
- case_decide; first done; destruct b,b0; simplify_eq /=; f_equal.
destruct op; simplify_eq /=; try done. }
+ simpl; destruct (bin_op_eval op #(dbase_lit_interp E dl1) v2);
try by inversion 1.
- simpl; destruct (bin_op_eval op v1 (dval_interp E dv2));
try by inversion 1.
Qed.
(** ** LocLookup *)
Class LocLookup (E : list loc) (l : loc) (i : nat) :=
loc_lookup : E !! i = Some l.
Global Instance loc_lookup_here l E : LocLookup (l :: E) l 0.
Proof. done. Qed.
Global Instance loc_lookup_there l l' E i :
LocLookup E l i LocLookup (l' :: E) l (S i).
Proof. done. Qed.
(** ** BaseLitQuote *)
Class BaseLitQuote (E : list loc) (l : base_lit) (dl : dbase_lit) :=
base_lit_quote : l = dbase_lit_interp E dl.
(** BaseLitQuote for locs *)
Global Instance base_lit_quote_loc E l i :
LocLookup E l i BaseLitQuote E (LitLoc l) (dLitLoc (dLoc i)) | 1.
Proof. by rewrite /LocLookup /BaseLitQuote /= => ->. Qed.
Global Instance base_lit_quote_loc_unknown E l :
BaseLitQuote E (LitLoc l) (dLitLoc (dLocUnknown l)) | 10.
Proof. done. Qed.
(** BaseLitQuote for constants *)
Global Instance base_lit_quote_int E i :
BaseLitQuote E (LitInt i) (dLitInt i).
Proof. by rewrite /BaseLitQuote /=. Qed.
Global Instance base_lit_quote_default E l :
BaseLitQuote E l (dLitUnknown l) | 1000.
Proof. done. Qed.
Class IntoDVal (E : list loc) (e : expr) (dv : dval) :=
into_dval : e = of_val (dval_interp E dv).
Global Instance into_dval_loc E l dl :
BaseLitQuote E l dl IntoDVal E (Lit l) (dLitV dl).
Proof. by rewrite /BaseLitQuote /IntoDVal=> ->. Qed.
Global Instance into_dval_default E e v :
IntoVal e v IntoDVal E e (dValUnknown v) | 1000.
Proof. by rewrite /IntoVal /IntoDVal=> /of_to_val ->. Qed.
From iris.proofmode Require Import environments coq_tactics.
Import env_notations.
From iris_c.vcgen Require Import dcexpr.
From iris_c.lib Require Import U locking_heap.
From iris_c.c_translation Require Import monad.
From iris.algebra Require Import frac.
Section splitenv.
Context `{amonadG Σ}.
Definition env_locs := list loc.
Definition env_ps := list (loc * (frac * val)).
Definition ps_loc (p : loc * (frac * val)) : loc := p.1.
Definition ps_frac (p : loc * (frac * val)) : frac := p.2.1.
Definition ps_val (p : loc * (frac * val)) : val := p.2.2.
Definition env_ps_interp (ps : env_ps) : iProp Σ :=
([ list] p ps, ps_loc p U{ps_frac p} ps_val p)%I.
Definition env_to_known_locs (Γls : env_ps) : env_locs := map fst Γls.
Class MapstoListFromEnv (Γin Γout : env (iProp Σ)) (Γls : env_ps) := {
mapsto_list_from_env :
[] Γin [] Γout env_ps_interp Γls;
mapsto_list_from_env_wf : env_wf Γin env_wf Γout;
mapsto_list_from_env_lookup_None i: Γin !! i = None Γout !! i = None
}.
Global Instance mapsto_list_from_env_nil : MapstoListFromEnv Enil Enil nil.
Proof. split; unfold env_ps_interp; eauto. Qed.
Global Instance mapsto_list_from_env_snoc_Γout Γin Γout Γls i P :
MapstoListFromEnv Γin Γout Γls
MapstoListFromEnv (Esnoc Γin i P) (Esnoc Γout i P) Γls | 100.
Proof.
destruct 1; split; simpl.
- rewrite mapsto_list_from_env0. iIntros "(H1 & H2 & H3)". iFrame.
- intro Hwf. inversion Hwf; subst. apply mapsto_list_from_env_wf0 in H4.
apply Esnoc_wf; last done. by apply mapsto_list_from_env_lookup_None0.
- intros j Hj. destruct (ident_beq j i); simplify_eq /=.
by apply mapsto_list_from_env_lookup_None0.
Qed.
Global Instance mapsto_list_from_env_snoc_Γls Γin Γout Γls i l q v :
MapstoListFromEnv Γin Γout Γls
MapstoListFromEnv (Esnoc Γin i (l U{q} v)) Γout ((l,(q,v))::Γls).
Proof.
destruct 1.
split.
- iIntros "H". simpl. iDestruct "H" as "[H1 H2]". iFrame.
by rewrite mapsto_list_from_env0.
- intros Heq. inversion Heq; simplify_eq /=. by apply mapsto_list_from_env_wf0.
- intros j Hsnoc. apply mapsto_list_from_env_lookup_None0.
destruct (decide (i = j)) as [->|]. simplify_eq /=. by destruct (ident_beq j j ).
by rewrite env_lookup_snoc_ne in Hsnoc.
Qed.
Definition exhale_list_interp E (ps : list (nat * (frac * dval))) : iProp Σ :=
([ list] lw ps, dloc_interp E (dLoc lw.1) U{lw.2.1} dval_interp E lw.2.2)%I.
Class ListOfMapsto (Γls : env_ps) (E : env_locs) (ps : list (nat * (frac * dval))) :=
list_of_mapsto : env_ps_interp Γls exhale_list_interp E ps.
Global Instance list_of_mapsto_Nil E : ListOfMapsto [] E [].
Proof. unfold ListOfMapsto. simpl. eauto. Qed.
Global Instance list_of_mapsto_cons_dLitV E Γls ps lit dlit i l q :
BaseLitQuote E lit dlit
LocLookup E l i
ListOfMapsto Γls E ps
ListOfMapsto ((l,(q,LitV lit))::Γls) E ((i,(q,dLitV dlit))::ps).
Proof.
rewrite /BaseLitQuote /LocLookup => Hlit Hi.
rewrite /ListOfMapsto => HΓls /=.
iDestruct 1 as "[Hl H]". cbn.
rewrite Hi Hlit. unfold env_ps_interp in *. rewrite HΓls. iFrame.
Qed.
Global Instance list_of_mapsto_cons_dValUnknown E Γls ps v i l q :
LocLookup E l i
ListOfMapsto Γls E ps
ListOfMapsto ((l,(q,v))::Γls) E ((i,(q,dValUnknown v))::ps) | 100.
Proof.
rewrite /BaseLitQuote /LocLookup => Hi.
rewrite /ListOfMapsto => HΓls /=.
iDestruct 1 as "[Hl H]". cbn.
unfold env_ps_interp in *. rewrite Hi HΓls. iFrame.
Qed.
Lemma tac_envs_split_mapsto Γs_in Γs_out Γls Γp c ps P:
MapstoListFromEnv Γs_in Γs_out Γls
ListOfMapsto Γls (env_to_known_locs Γls) ps
envs_entails (Envs Γp Γs_out c) (exhale_list_interp (env_to_known_locs Γls) ps - P)%I
envs_entails (Envs Γp Γs_in c) P.
Proof.
intros Hsplit. rewrite /ListOfMapsto coq_tactics.envs_entails_eq=> Hexhale.
unfold of_envs. simpl.
rewrite mapsto_list_from_env. intros Hz.
iIntros "(Hwf & #Hp & Hs & Hls)". iDestruct "Hwf" as %Hwf.
iApply (Hz with "[Hs]").
- iFrame "Hp Hs". iPureIntro.
split; eauto.
+ apply Hwf.
+ apply Hsplit. apply Hwf.
+ intros i. simpl. destruct (envs_disjoint _ Hwf i) as [Hp | Hp]; simpl in Hp.
* by left.
* right. by apply Hsplit.
- by iApply Hexhale.
Qed.
End splitenv.
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