Commit 5fb2e503 authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

Random stuff that breaks everything:

- Add support for fst/snd/pair to the vcg_gen + reified expressions for non-monadic expressions.
- Make `cloc_to_val` locked so that it will _never_ be unfolded.
- Support locations + offsets in the reified language.
- Drop `vcg_compute`, it left huge thunks of computation, making some things super slow. Just use `simpl` with appropriate `Arguments` instead.
parent 84d87469
......@@ -120,16 +120,16 @@ Definition cbin_op_eval (op : cbin_op) (v1 v2 : val) : option val :=
match op with
| CBinOp op' => bin_op_eval op' v1 v2
| PtrPlusOp =>
cl cloc_of_val v1;
o offset_of_val v2;
Some (cloc_to_val (cloc_add cl o))
cl cloc_of_val v1;
o offset_of_val v2;
Some (cloc_to_val (cloc_plus cl o))
| PtrLtOp =>
cl1 cloc_of_val v1;
cl2 cloc_of_val v2;
Some #(cloc_lt cl1 cl2)
cl1 cloc_of_val v1;
cl2 cloc_of_val v2;
Some #(cloc_lt cl1 cl2)
end.
Definition a_ptr_add : val := λ: "x" "y",
Definition a_ptr_plus : val := λ: "x" "y",
"lo" ←ᶜ ("x" ||| "y");;
let: "o'" := Snd (Fst "lo") + Snd "lo" in
a_ret (Fst (Fst "lo"), "o'").
......@@ -142,11 +142,10 @@ Definition a_ptr_lt : val := λ: "x" "y",
Definition a_bin_op (op : cbin_op) : val :=
match op with
| CBinOp op' =>
λ: "x1" "x2",
"vv" ←ᶜ "x1" ||| "x2" ;;
a_ret (BinOp op' (Fst "vv") (Snd "vv"))
| PtrPlusOp => a_ptr_add
| CBinOp op' => λ: "x1" "x2",
"vv" ←ᶜ "x1" ||| "x2" ;;
a_ret (BinOp op' (Fst "vv") (Snd "vv"))
| PtrPlusOp => a_ptr_plus
| PtrLtOp => a_ptr_lt
end.
......@@ -193,7 +192,8 @@ Section proofs.
wp_apply (lreplicate_spec with "[//]"); iIntros (ll Hll).
iApply wp_fupd. wp_alloc l as "Hl".
iMod (locking_heap_alloc with "Hσ Hl") as (?) "[Hσ Hl]"; first done.
iIntros "!> !>". iSplitL "Hlocks Hσ"; [|by iApply ("HΦ" $! (l, 0%nat))].
iIntros "!> !>". rewrite cloc_to_val_eq.
iSplitL "Hlocks Hσ"; [|by iApply ("HΦ" $! (l, 0%nat))].
iExists X, _. iFrame.
iIntros "!%". intros w Hw. destruct (HX _ Hw) as (cl&Hcl&Hin).
exists cl; split; first done. by rewrite locked_locs_alloc_heap.
......@@ -211,14 +211,15 @@ Section proofs.
awp_apply (a_wp_awp with "H2"); iIntros (v2) "H2". awp_lam.
iApply awp_bind. iApply (awp_par with "H1 H2").
iIntros "!>" (w1 w2) "H1 H2 !>". awp_lam.
iDestruct ("HΦ" with "H1 H2") as ([l i] w ->) "[Hl HΦ]".
iDestruct ("HΦ" with "H1 H2") as (cl w ->) "[Hl HΦ]".
iApply awp_atomic_env.
iIntros (env). iDestruct 1 as (X σ HX) "[Hlocks Hσ]". iIntros "HR".
iDestruct (locked_locs_unlocked with "Hl Hσ") as %Hw1.
assert ((#l, #i)%V X).
{ intros Hcl. destruct (HX _ Hcl) as ([??]&[=]%cloc_to_of_val&?); naive_solver. }
assert (cloc_to_val cl X) as HclX.
{ intros Hcl. destruct (HX _ Hcl) as (cl'&[=]%cloc_to_of_val&?). naive_solver. }
rewrite cloc_to_val_eq in HclX.
iMod (locking_heap_store with "Hσ Hl") as (ll vs Hl Hi) "[Hl Hclose]".
wp_let. do 2 wp_proj; wp_let. do 2 wp_proj; wp_let. wp_proj; wp_let.
wp_let. rewrite cloc_to_val_eq. do 2 wp_proj; wp_let. do 2 wp_proj; wp_let. wp_proj; wp_let.
wp_apply (mset_add_spec with "[$]"); first done.
iIntros "Hlocks /="; wp_seq.
wp_load; wp_match.
......@@ -226,10 +227,10 @@ Section proofs.
iApply wp_fupd. wp_store.
iMod ("Hclose" $! _ LLvl with "[//] Hl") as "[Hσ Hl]".
iIntros "!> !> {$HR}". iSplitL "Hlocks Hσ"; last by iApply "HΦ".
iExists ({[(#l, #i)%V]} X), _. iFrame "Hσ". rewrite locked_locs_lock.
iIntros "{$Hlocks} !%".
iExists ({[cloc_to_val cl]} X), _. iFrame "Hσ". rewrite locked_locs_lock.
iSplit; last by rewrite cloc_to_val_eq. iPureIntro.
intros v [->%elem_of_singleton|?]%elem_of_union; last set_solver.
eexists; split; [apply (cloc_of_to_val (l,i))|set_solver].
eexists. split; [apply (cloc_of_to_val cl)|set_solver].
Qed.
Lemma a_load_spec_exists_frac R Φ e :
......@@ -240,14 +241,15 @@ Section proofs.
iIntros "H".
awp_apply (a_wp_awp with "H"); iIntros (v) "H". awp_lam.
iApply awp_bind. iApply (awp_wand with "H"). clear v.
iIntros (v). iDestruct 1 as ([l i] q w ->) "[Hl HΦ]". awp_lam.
iIntros (v). iDestruct 1 as (cl q w ->) "[Hl HΦ]". awp_lam.
iApply awp_atomic_env. iIntros (env) "Henv HR".
iDestruct "Henv" as (X σ HX) "[Hlocks Hσ]".
iDestruct (locked_locs_unlocked with "Hl Hσ") as %Hv.
assert ((#l, #i)%V X).
{ intros Hcl. destruct (HX _ Hcl) as ([??]&[=]%cloc_to_of_val&?); naive_solver. }
assert (cloc_to_val cl X) as HclX.
{ intros Hcl. destruct (HX _ Hcl) as (?&[=]%cloc_to_of_val&?); naive_solver. }
rewrite cloc_to_val_eq in HclX.
iMod (locking_heap_load with "Hσ Hl") as (ll vs Hl Hi) "[Hl Hclose]".
wp_let. wp_proj; wp_let. wp_proj; wp_let.
wp_let. rewrite cloc_to_val_eq. wp_proj; wp_let. wp_proj; wp_let.
wp_apply wp_assert. wp_apply (mset_member_spec with "Hlocks"); iIntros "Hlocks /=".
rewrite bool_decide_false //.
wp_op. iSplit; first done. iNext; wp_seq.
......@@ -282,7 +284,7 @@ Section proofs.
Lemma a_seq_spec R Φ :
U (Φ #()) -
AWP (a_seq #()) @ R {{ Φ }}.
AWP a_seq #() @ R {{ Φ }}.
Proof.
iIntros "HΦ". rewrite /a_seq. awp_lam.
iApply awp_atomic_env. iIntros (env) "Henv $". iApply wp_fupd.
......@@ -410,20 +412,21 @@ Section proofs.
iRight. iSplit; eauto. by awp_seq.
Qed.
Lemma a_ptr_add_spec R Φ Ψ2 e1 e2 :
Lemma a_ptr_plus_spec R Φ Ψ2 e1 e2 :
AWP e2 @ R {{ Ψ2 }} -
AWP e1 @ R {{ v1, v2, Ψ2 v2 - cl (n : nat),
v1 = cloc_to_val cl
v2 = #n
Φ (cloc_to_val (cloc_add cl n)) }} -
AWP a_ptr_add e1 e2 @ R {{ Φ }}.
Φ (cloc_to_val (cloc_plus cl n)) }} -
AWP a_ptr_plus e1 e2 @ R {{ Φ }}.
Proof.
iIntros "He2 HΦ". rewrite /a_ptr_add.
iIntros "He2 HΦ". rewrite /a_ptr_plus.
awp_apply (a_wp_awp with "HΦ"); iIntros (a1) "Ha1". awp_lam.
awp_apply (a_wp_awp with "He2"); iIntros (a2) "Ha2". awp_lam.
iApply awp_bind. iApply (awp_par with "Ha1 Ha2"). iNext.
iIntros (v1 v2) "Hv1 Hv2 !>". awp_let.
iDestruct ("Hv1" with "Hv2") as ([l o] n -> ->) "HΦ /=".
iDestruct ("Hv1" with "Hv2") as (cl n -> ->) "HΦ /=".
rewrite cloc_to_val_eq.
do 3 awp_proj. awp_op. awp_let. do 2 awp_proj.
iApply awp_ret. iApply wp_value. by rewrite -Nat2Z.inj_add.
Qed.
......@@ -436,12 +439,13 @@ Section proofs.
Φ #(cloc_lt p q) }} -
AWP a_ptr_lt e1 e2 @ R {{ Φ }}.
Proof.
iIntros "He1 HΦ". rewrite /a_ptr_add.
iIntros "He1 HΦ". rewrite /a_ptr_plus.
awp_apply (a_wp_awp with "He1"); iIntros (a1) "Ha1". awp_lam.
awp_apply (a_wp_awp with "HΦ"); iIntros (a2) "Ha2". awp_lam.
iApply awp_bind. iApply (awp_par with "Ha1 Ha2"). iNext.
iIntros (v1 v2) "Hv1 Hv2 !>". awp_let.
iDestruct ("Hv2" with "Hv1") as ([pl pi] [ql qi] -> ->) "HΦ /=".
rewrite cloc_to_val_eq.
do 2 (awp_proj; awp_let). do 2 awp_proj.
unfold cloc_lt; simpl. case_bool_decide as Hp; subst; awp_op.
- rewrite (bool_decide_true (LitV ql = LitV ql)) //. awp_if. do 2 awp_proj.
......@@ -466,7 +470,7 @@ Section proofs.
iNext. awp_lam. iApply awp_ret. do 2 wp_proj.
iSpecialize ("HΦ" with "HΨ1 HΨ2").
iDestruct "HΦ" as (w0) "[% H]". by wp_pure _.
- iApply (a_ptr_add_spec with "H2").
- iApply (a_ptr_plus_spec with "H2").
iApply (awp_wand with "H1").
iIntros (v1) "HΨ1". iNext.
iIntros (v2) "HΨ2". iDestruct ("HΦ" with "HΨ1 HΨ2") as (w hop) "HΦ".
......
......@@ -93,9 +93,9 @@ Section definitions.
(** Pointer arithmetic *)
Definition cloc_lt (p q : cloc) : bool :=
bool_decide (p.1 = q.1) && bool_decide (p.2 < q.2)%nat.
Definition cloc_add (cl : cloc) (i : nat) : cloc := (cl.1, cl.2 + i).
Definition cloc_plus (cl : cloc) (i : nat) : cloc := (cl.1, cl.2 + i).
Definition cloc_to_val (cl : cloc) : val := (#cl.1, #cl.2).
Definition cloc_to_val (cl : cloc) : val := locked (#cl.1, #cl.2)%V.
Definition cloc_of_val (v : val) : option cloc :=
match v return option (loc * nat) with
| (LitV (LitLoc l), LitV (LitInt i))%V => guard (0 i)%Z; Some (l, Z.to_nat i)
......@@ -134,10 +134,10 @@ Notation "cl ↦C v" := (cl ↦C[ULvl]{1} v)%I
(at level 20, format "cl ↦C v") : bi_scope.
Notation "cl ↦C{ q }∗ vs" :=
([ list] i v vs, cloc_add cl i C{q} v)%I
([ list] i v vs, cloc_plus cl i C{q} v)%I
(at level 20, q at level 50, format "cl ↦C{ q }∗ vs") : bi_scope.
Notation "cl ↦C∗ vs" :=
([ list] i v vs, cloc_add cl i C v)%I
([ list] i v vs, cloc_plus cl i C v)%I
(at level 20, format "cl ↦C∗ vs") : bi_scope.
Lemma to_locking_heap_valid (σ : gmap cloc (lvl * val)) : to_locking_heap σ.
......@@ -212,19 +212,27 @@ Section properties.
Lemma mapsto_downgrade lv cl q v : cl C{q} v - cl C[lv]{q} v.
Proof. apply mapsto_downgrade'. by apply lvl_included. Qed.
Lemma cloc_add_0 cl : cloc_add cl 0 = cl.
Proof. rewrite /cloc_add Nat.add_0_r. by destruct cl. Qed.
Lemma cloc_add_add cl i j : cloc_add (cloc_add cl i) j = cloc_add cl (i + j).
Proof. by rewrite /cloc_add /= Nat.add_assoc. Qed.
Lemma cloc_plus_0 cl : cloc_plus cl 0 = cl.
Proof. rewrite /cloc_plus Nat.add_0_r. by destruct cl. Qed.
Lemma cloc_plus_plus cl i j : cloc_plus (cloc_plus cl i) j = cloc_plus cl (i + j).
Proof. by rewrite /cloc_plus /= Nat.add_assoc. Qed.
Lemma cloc_to_val_eq : cloc_to_val = λ cl, (#cl.1, #cl.2)%V.
Proof. rewrite /cloc_to_val. by unlock. Qed.
Lemma cloc_of_to_val cl : cloc_of_val (cloc_to_val cl) = Some cl.
Proof. destruct cl. by rewrite /= option_guard_True ?Nat2Z.id; last lia. Qed.
Proof.
destruct cl.
by rewrite cloc_to_val_eq /= option_guard_True ?Nat2Z.id; last lia.
Qed.
Lemma cloc_to_of_val v cl : cloc_of_val v = Some cl cloc_to_val cl = v.
Proof.
rewrite /cloc_of_val /cloc_to_val=> ?.
rewrite /cloc_of_val cloc_to_val_eq=> ?.
destruct cl; repeat (case_match || simplify_option_eq); auto.
by rewrite Z2Nat.inj_pos positive_nat_Z.
Qed.
Global Instance cloc_to_val_inj : Inj (=) (=) cloc_to_val.
Proof. intros cl1 cl2 Hcl. apply (inj Some). by rewrite -!cloc_of_to_val Hcl. Qed.
Lemma offset_of_to_val (o : nat) : offset_of_val #o = Some o.
Proof. by rewrite /= option_guard_True ?Nat2Z.id; last lia. Qed.
Lemma offset_to_of_val v (o : nat) : offset_of_val v = Some o v = #o.
......
......@@ -4,8 +4,9 @@ From iris_c.c_translation Require Export translation proofmode.
Definition known_locs := list cloc.
(* RK: We should also record an offset for unknown locations, ideally. *)
Inductive dloc :=
| dLoc : nat dloc
| dLoc : nat nat dloc (* index * offset *)
| dLocUnknown : cloc dloc.
Global Instance dloc_decision : EqDecision dloc.
......@@ -33,7 +34,7 @@ Proof. solve_decision. Defined.
Definition dloc_interp (E : known_locs) (dl : dloc) : cloc :=
match dl with
| dLoc i => default inhabitant (E !! i)
| dLoc i j => cloc_plus (default inhabitant (E !! i)) j
| dLocUnknown l => l
end.
......@@ -108,13 +109,10 @@ Definition dbin_op_eval
Definition dptr_plus_eval (E: known_locs) (dv1 dv2 : dval) : option dval :=
match dv1,dv2 with
| dLocV (dLoc i), dLitV (dLitInt o) =>
(* DF: TODO: THIS MAY VERY BLOCK SIMPLIFICATION *)
(* TO PROPERLY HANDLE THIS CASE PLEASE DEEPLY EMBED THE NATURALS *)
| dLocV (dLoc i j), dLitV (dLitInt o) =>
match offset_of_val (LitV (LitInt o)) with
| None => None
| Some n =>
Some $ dLocV $ dLocUnknown $ cloc_add (dloc_interp E (dLoc i)) n
| Some k => Some $ dLocV $ dLoc i (j + k)
end
| _,_ => None
end.
......@@ -123,13 +121,9 @@ Lemma dptr_plus_eval_correct E dv1 dv2 w :
dptr_plus_eval E dv1 dv2 = Some w
cbin_op_eval PtrPlusOp (dval_interp E dv1) (dval_interp E dv2) = Some (dval_interp E w).
Proof.
destruct dv1 as [?|??|[]|u1],dv2 as [[]|??|?|u2]; try naive_solver.
destruct dv1 as [?|??|[??|]|u1],dv2 as [[]|??|?|u2]; try naive_solver.
rewrite /cbin_op_eval /=. case_option_guard; inversion 1.
simplify_eq/=. repeat (case_option_guard; last omega).
simpl. repeat f_equal. rewrite Nat2Z.id.
(* TODO: WTF? *)
destruct (default (1%positive, 0%nat) (E !! n)) as [? ?] eqn:lol.
by rewrite lol.
by rewrite cloc_of_to_val /= cloc_plus_plus.
Qed.
Definition dcbin_op_eval (E: known_locs) (op : cbin_op) (dv1 dv2 : dval) : option dval :=
......@@ -183,9 +177,26 @@ Proof.
destruct op, dl; intros; simplify_eq/=; auto.
Qed.
(** Dexpr *)
Inductive dexpr : Type :=
| dEVal : dval dexpr
| dEPair : dexpr dexpr dexpr
| dEFst : dexpr dexpr
| dESnd : dexpr dexpr
| dEUnknown (e : expr) `{!Closed [] e} : dexpr.
Fixpoint dexpr_interp (E: known_locs) (de: dexpr) : expr :=
match de with
| dEVal dv => dval_interp E dv
| dEPair de1 de2 => (dexpr_interp E de1, dexpr_interp E de2)
| dEFst de => Fst (dexpr_interp E de)
| dESnd de => Snd (dexpr_interp E de)
| dEUnknown e => e
end.
(** DCexpr *)
Inductive dcexpr : Type :=
| dCRet : dval dcexpr
| dCRet : dexpr dcexpr
| dCAlloc : dcexpr dcexpr dcexpr
| dCLoad : dcexpr dcexpr
| dCStore : dcexpr dcexpr dcexpr
......@@ -199,7 +210,7 @@ Inductive dcexpr : Type :=
Fixpoint dcexpr_interp (E: known_locs) (de: dcexpr) : expr :=
match de with
| dCRet dv => a_ret (dval_interp E dv)
| dCRet de => a_ret (dexpr_interp E de)
| dCAlloc de1 de2 => a_alloc (dcexpr_interp E de1) (dcexpr_interp E de2)
| dCLoad de1 => a_load (dcexpr_interp E de1)
| dCStore de1 de2 => a_store (dcexpr_interp E de1) (dcexpr_interp E de2)
......@@ -218,13 +229,21 @@ Fixpoint dcexpr_interp (E: known_locs) (de: dcexpr) : expr :=
Fixpoint dval_wf (E: known_locs) (dv : dval) : bool :=
match dv with
| dPairV dv1 dv2 => dval_wf E dv1 && dval_wf E dv2
| dLocV (dLoc i) => bool_decide (is_Some (E !! i))
| dLocV (dLoc i _) => bool_decide (is_Some (E !! i))
| _ => true
end.
Fixpoint dexpr_wf (E: known_locs) (de: dexpr) : bool :=
match de with
| dEVal dv => dval_wf E dv
| dEFst de | dESnd de => dexpr_wf E de
| dEPair de1 de2 => dexpr_wf E de1 && dexpr_wf E de2
| dEUnknown _ => true
end.
Fixpoint dcexpr_wf (E: known_locs) (de: dcexpr) : bool :=
match de with
| dCRet dv => dval_wf E dv
| dCRet de => dexpr_wf E de
| dCLoad de1 | dCUnOp _ de1 | dCInvoke _ de1 => dcexpr_wf E de1
| dCAlloc de1 de2 | dCStore de1 de2 | dCBinOp _ de1 de2
| dCPreBinOp _ de1 de2 | dCSeq de1 de2 | dCPar de1 de2 =>
......@@ -248,9 +267,13 @@ Proof.
* specialize (prefix_cons_inv_2 _ _ _ _ Hpre). naive_solver.
Qed.
Lemma dexpr_wf_mono (E E': known_locs) (de: dexpr) :
dexpr_wf E de E `prefix_of` E' dexpr_wf E' de.
Proof. induction de; simplify_eq /=; [apply dval_wf_mono|..]; naive_solver. Qed.
Lemma dcexpr_wf_mono (E E': known_locs) (de: dcexpr) :
dcexpr_wf E de E `prefix_of` E' dcexpr_wf E' de.
Proof. induction de; simplify_eq /=; [apply dval_wf_mono|..]; naive_solver. Qed.
Proof. induction de; simplify_eq /=; [apply dexpr_wf_mono|..]; naive_solver. Qed.
Lemma dun_op_eval_Some_wf E dv u dw:
dval_wf E dv dun_op_eval E u dv = Some dw dval_wf E dw.
......@@ -288,6 +311,17 @@ Proof.
* specialize (prefix_cons_inv_2 _ _ _ _ Hpre). naive_solver.
Qed.
Lemma dexpr_interp_mono (E E': known_locs) (de: dexpr) :
dexpr_wf E de E `prefix_of` E' dexpr_interp E de = dexpr_interp E' de.
Proof.
induction de; simplify_eq /=; intros H Hpre;
try (by rewrite IHde ) ||
(apply andb_prop_elim in H as [H1 H2];
rewrite IHde2; [rewrite IHde1; done | done | done ];
by rewrite (IHde1 H1 Hpre (dcexpr_interp E de1))) || eauto.
by rewrite (dval_interp_mono E E').
Qed.
Lemma dcexpr_interp_mono (E E': known_locs) (de: dcexpr) :
dcexpr_wf E de E `prefix_of` E' dcexpr_interp E de = dcexpr_interp E' de.
Proof.
......@@ -296,11 +330,17 @@ Proof.
(apply andb_prop_elim in H as [H1 H2];
rewrite IHde2; [rewrite IHde1; done | done | done ];
by rewrite (IHde1 H1 Hpre (dcexpr_interp E de1))) || eauto.
do 2 f_equal. by apply dval_interp_mono.
by rewrite (dexpr_interp_mono E E').
Qed.
Global Instance dexpr_closed E de : Closed [] (dexpr_interp E de).
Proof. induction de; simpl; try solve_closed. Qed.
Global Instance dcexpr_closed E de : Closed [] (dcexpr_interp E de).
Proof. induction de; simpl; solve_closed. Qed.
Proof.
induction de; simpl; try solve_closed. rewrite /Closed /=.
split_and. change (Closed [] a_ret). solve_closed. apply (dexpr_closed E d).
Qed.
(** * Reification of C syntax *)
(** ** LocLookup *)
......@@ -314,6 +354,17 @@ Global Instance loc_lookup_there l l' E i :
LocLookup E l i LocLookup (l' :: E) l (S i).
Proof. done. Qed.
Class IntoCLocPlus (l : cloc) (k : cloc) (j : nat) :=
into_cloc_plus : l = cloc_plus k j.
Global Instance into_cloc_plus_here l : IntoCLocPlus l l 0 | 100.
Proof. by rewrite /IntoCLocPlus cloc_plus_0. Qed.
Global Instance into_cloc_plus_plus l l' i j :
IntoCLocPlus l l' i
IntoCLocPlus (cloc_plus l j) l' (i + j).
Proof. rewrite /IntoCLocPlus=> ->. by rewrite cloc_plus_plus. Qed.
(** ** IntoDBaseLit *)
Class IntoDBaseLit (E : known_locs) (l : base_lit) (dl : dbase_lit) :=
into_dbase_lit : l = dbase_lit_interp E dl.
......@@ -335,23 +386,15 @@ Global Instance expr_into_dval_lit E l dl :
IntoDBaseLit E l dl ExprIntoDVal E (Lit l) (dLitV dl).
Proof. intros ?; split=> //=. rewrite -into_dbase_lit //. Qed.
Global Instance expr_into_dval_loc E l i :
LocLookup E l i ExprIntoDVal E (cloc_to_val l) (dLocV (dLoc i)) | 1.
Proof. rewrite /LocLookup=> Hi. split; rewrite /= ?Hi //. Qed.
Global Instance expr_into_dval_loc E l k i j :
IntoCLocPlus l k j
LocLookup E k i ExprIntoDVal E (cloc_to_val l) (dLocV (dLoc i j)) | 1.
Proof. rewrite /IntoCLocPlus /LocLookup=> -> Hi. split; rewrite /= ?Hi //. Qed.
Global Instance expr_into_dval_loc_unknown E l :
ExprIntoDVal E (cloc_to_val l) (dLocV (dLocUnknown l)) | 10.
ExprIntoDVal E (cloc_to_val l) (dLocV (dLocUnknown l)) | 100.
Proof. done. Qed.
(* TODO: use ValToNat for those two instance below *)
Global Instance expr_into_dval_cloc_pos E (l : loc) (o : positive) i :
LocLookup E (l,Pos.to_nat o) i ExprIntoDVal E (#l,#(Zpos o)) (dLocV (dLoc i)) | 1.
Proof. rewrite /LocLookup=> Hi. split; rewrite /= ?Hi -?positive_nat_Z //. Qed.
Global Instance expr_into_dval_cloc_zero E (l : loc) i :
LocLookup E (l,0%nat) i ExprIntoDVal E (#l,#0) (dLocV (dLoc i)) | 1.
Proof. rewrite /LocLookup=> Hi. split; rewrite /= ?Hi //. Qed.
Global Instance expr_into_dval_default E e v :
IntoVal e v ExprIntoDVal E e (dValUnknown v) | 1000.
Proof. done. Qed.
......@@ -365,9 +408,10 @@ Global Instance into_dval_lit E l dl :
IntoDBaseLit E l dl IntoDVal E (LitV l) (dLitV dl).
Proof. intros ?; split=> //=. rewrite -into_dbase_lit //. Qed.
Global Instance into_dval_loc E l i :
LocLookup E l i IntoDVal E (cloc_to_val l) (dLocV (dLoc i)) | 1.
Proof. rewrite /LocLookup=> Hi. split; rewrite /= ?Hi //. Qed.
Global Instance into_dval_loc E l k i j :
IntoCLocPlus l k j
LocLookup E k i IntoDVal E (cloc_to_val l) (dLocV (dLoc i j)) | 1.
Proof. rewrite /IntoCLocPlus /LocLookup=> -> Hi. split; rewrite /= ?Hi //. Qed.
Global Instance into_dval_loc_unknown E l :
ExprIntoDVal E (cloc_to_val l) (dLocV (dLocUnknown l)) | 10.
......@@ -376,69 +420,98 @@ Proof. done. Qed.
Global Instance into_dval_default E v : IntoDVal E v (dValUnknown v) | 1000.
Proof. done. Qed.
(** ** IntoDCexpr *)
Class IntoDCexpr (E: known_locs) (e: expr) (de: dcexpr) :=
(** ** IntoDExpr *)
Class IntoDExpr (E: known_locs) (e: expr) (de: dexpr) :=
{ into_dexpr : e = dexpr_interp E de;
into_dexpr_wf : dexpr_wf E de }.
Global Instance into_dexpr_val E e dv :
ExprIntoDVal E e dv
IntoDExpr E e (dEVal dv) | 5.
Proof. intros [-> ?]; split; auto. Qed.
Global Instance into_dexpr_pair E e1 e2 de1 de2 :
IntoDExpr E e1 de1 IntoDExpr E e2 de2
IntoDExpr E (Pair e1 e2) (dEPair de1 de2).
Proof. intros [-> ?] [-> ?]; split; simpl; auto. Qed.
Global Instance into_dexpr_fst E e de:
IntoDExpr E e de
IntoDExpr E (Fst e) (dEFst de).
Proof. intros [-> ?]; split; auto. Qed.
Global Instance into_dexpr_snd E e de:
IntoDExpr E e de
IntoDExpr E (Snd e) (dESnd de).
Proof. intros [-> ?]; split; auto. Qed.
Global Instance into_dexpr_unknown E e `{Closed [] e}:
IntoDExpr E e (dEUnknown e) | 100.
Proof. done. Qed.
(** ** IntoDCExpr *)
Class IntoDCExpr (E: known_locs) (e: expr) (de: dcexpr) :=
{ into_dcexpr : e = dcexpr_interp E de;
into_dcexpr_wf : dcexpr_wf E de }.
Global Instance into_dcexpr_ret E v dv:
ExprIntoDVal E v dv
IntoDCexpr E (a_ret v) (dCRet dv).
Global Instance into_dcexpr_ret E e de:
IntoDExpr E e de
IntoDCExpr E (a_ret e) (dCRet de).
Proof. intros [-> ?]; split; auto. Qed.
Global Instance into_dcexpr_alloc E e1 e2 de1 de2 :
IntoDCexpr E e1 de1 IntoDCexpr E e2 de2
IntoDCexpr E (a_alloc e1 e2) (dCAlloc de1 de2).
IntoDCExpr E e1 de1 IntoDCExpr E e2 de2
IntoDCExpr E (a_alloc e1 e2) (dCAlloc de1 de2).
Proof. intros [-> ?] [-> ?]; split; simpl; auto. Qed.
Global Instance into_dcexpr_load E e de:
IntoDCexpr E e de
IntoDCexpr E (a_load e) (dCLoad de).
IntoDCExpr E e de
IntoDCExpr E (a_load e) (dCLoad de).
Proof. intros [-> ?]; split; auto. Qed.
Global Instance into_dcexpr_store E e1 e2 de1 de2:
IntoDCexpr E e1 de1
IntoDCexpr E e2 de2
IntoDCexpr E (a_store e1 e2) (dCStore de1 de2).
IntoDCExpr E e1 de1
IntoDCExpr E e2 de2
IntoDCExpr E (a_store e1 e2) (dCStore de1 de2).
Proof. intros [-> ?] [-> ?]; split; simpl; auto. Qed.
Global Instance into_dcexpr_binop E e1 e2 op de1 de2:
IntoDCexpr E e1 de1
IntoDCexpr E e2 de2
IntoDCexpr E (a_bin_op op e1 e2) (dCBinOp op de1 de2).
IntoDCExpr E e1 de1
IntoDCExpr E e2 de2
IntoDCExpr E (a_bin_op op e1 e2) (dCBinOp op de1 de2).
Proof. intros [-> ?] [-> ?]; split; simpl; auto. Qed.
Global Instance into_dcexpr_prebinop E e1 e2 op de1 de2:
IntoDCexpr E e1 de1
IntoDCexpr E e2 de2
IntoDCexpr E (a_pre_bin_op op e1 e2) (dCPreBinOp op de1 de2).