Commit a063d2d6 by Hai Dang

### fix function results; add lemma for var

 ... ... @@ -186,6 +186,24 @@ Proof. apply never_stuck_tstep_tc'. Qed. (** PURE STEP ----------------------------------------------------------------*) (** Var *) Lemma fill_var_decompose K e var: fill K e = Var var → K = [] ∧ e = Var var. Proof. revert e. induction K as [|Ki K IH]; [done|]. simpl; intros ? [? ?]%IH. by destruct Ki. Qed. Lemma tstep_var_inv var e' σ σ' : (Var var, σ) ~{fns}~> (e', σ') → False. Proof. intros STEP. inv_tstep. symmetry in Eq. destruct (fill_var_decompose _ _ _ Eq); subst. simpl in HS. inv_head_step. Qed. (** BinOp *) Lemma fill_bin_op_decompose K e op e1 e2: fill K e = BinOp op e1 e2 → ... ...
 ... ... @@ -2,7 +2,7 @@ From stbor.lang Require Import steps_inversion. From stbor.sim Require Export local invariant. Notation "r ⊨{ n , fs , ft } ( es , σs ) ≥ ( et , σt ) : Φ" := (sim_local_body wsat rrel fs ft r n%nat es%E σs et%E σt Φ) (sim_local_body wsat vrel fs ft r n%nat es%E σs et%E σt Φ) (at level 70, format "'[hv' r '/' ⊨{ n , fs , ft } '/ ' '[ ' ( es , '/' σs ) ']' '/' ≥ '/ ' '[ ' ( et , '/' σt ) ']' '/' : Φ ']'"). ... ... @@ -14,7 +14,7 @@ fn table, allow giving a lower bound. But this is good enough for now. This could be done in general, but we just do it for the instance. *) Definition sim_mod_fun f1 f2 := ∀ fs ft, sim_local_funs_lookup fs ft → sim_local_fun wsat rrel fs ft end_call_sat f1 f2. sim_local_fun wsat vrel fs ft end_call_sat f1 f2. Definition sim_mod_funs (fns fnt: fn_env) := ∀ name fn_src, fns !! name = Some fn_src → ∃ fn_tgt, ... ... @@ -67,7 +67,7 @@ Qed. assumption. *) Lemma sim_mod_funs_local fs ft : sim_mod_funs fs ft → sim_local_funs wsat rrel fs ft end_call_sat. sim_local_funs wsat vrel fs ft end_call_sat. Proof. intros Hmod. intros f fn_src Hlk. destruct (Hmod _ _ Hlk) as (fn_tgt & ? & ? & ?). exists fn_tgt. ... ... @@ -84,3 +84,47 @@ Proof. intros Hne (ebs & HCs & EQ). exists ebs, HCs. rewrite lookup_insert_ne //. Qed. Lemma rrel_eq r (e1 e2: result) : rrel vrel r e1 e2 → e1 = e2. Proof. destruct e1, e2; simpl; [|done..|]. - intros ?. f_equal. by eapply vrel_eq. - intros [VREL ?]. subst. apply vrel_eq in VREL. by simplify_eq. Qed. Lemma rrel_mono (r1 r2 : resUR) (VAL: ✓ r2) : r1 ≼ r2 → ∀ v1 v2, rrel vrel r1 v1 v2 → rrel vrel r2 v1 v2. Proof. intros Le v1 v2. destruct v1, v2; simpl; [|done..|]. - by apply vrel_mono. - intros [VREL ?]. split; [|done]. move : VREL. by apply vrel_mono. Qed. Lemma list_Forall_result_value (es: list result) (vs: list value) : of_result <\$> es = Val <\$> vs → es = ValR <\$> vs. Proof. revert vs. induction es as [|e es IH]; intros vs. { intros Eq. symmetry in Eq. apply fmap_nil_inv in Eq. by subst vs. } destruct vs as [|v vs]; [by intros ?%fmap_nil_inv|]. rewrite 3!fmap_cons. intros Eq. inversion Eq as [Eq1]. rewrite (IH vs) //. f_equal. have Eq2 := to_of_result e. rewrite Eq1 /= in Eq2. by simplify_eq. Qed. Lemma list_Forall_rrel_vrel r (es et: list result) : Forall2 (rrel vrel r) es et → Forall (λ ei : expr, is_Some (to_value ei)) (of_result <\$> es) → Forall (λ ei : expr, is_Some (to_value ei)) (of_result <\$> et) → ∃ vs vt, es = ValR <\$> vs ∧ et = ValR <\$> vt ∧ Forall2 (vrel r) vs vt. Proof. intros RREL [vs Eqs]%list_Forall_to_value [vt Eqt]%list_Forall_to_value. exists vs, vt. apply list_Forall_result_value in Eqs. apply list_Forall_result_value in Eqt. subst es et. do 2 (split; [done|]). by rewrite -> Forall2_fmap in RREL. Qed.
 ... ... @@ -101,16 +101,6 @@ Definition wsat (r: resUR) (σs σt: state) : Prop := (* Values passed among functions are public *) Definition vrel (r: resUR) (v1 v2: value) := Forall2 (arel r) v1 v2. Definition rrel (r: resUR) rs rt: Prop := match rs, rt with | ValR vs, ValR vt => vrel r vs vt | PlaceR ls ts Ts, PlaceR lt t_t Tt => (* Places are related like pointers, and the types must be equal. *) vrel r [ScPtr ls ts] [ScPtr lt t_t] ∧ Ts = Tt | _, _ => False end. (** Condition for resource before EndCall *) (* The call id [c] to be end must not have any privately protected locations. *) Definition end_call_sat (r: resUR) (c: call_id) : Prop := ... ... @@ -148,14 +138,6 @@ Proof. f_equal. by apply (arel_eq _ _ _ Eq1). by apply IH. Qed. Lemma rrel_eq r (e1 e2: result) : rrel r e1 e2 → e1 = e2. Proof. destruct e1, e2; simpl; [|done..|]. - intros ?. f_equal. by eapply vrel_eq. - intros [VREL ?]. subst. apply vrel_eq in VREL. by simplify_eq. Qed. Lemma arel_mono (r1 r2 : resUR) (VAL: ✓ r2) : r1 ≼ r2 → ∀ s1 s2, arel r1 s1 s2 → arel r2 s1 s2. Proof. ... ... @@ -184,14 +166,6 @@ Lemma vrel_mono (r1 r2 : resUR) (VAL: ✓ r2) : r1 ≼ r2 → ∀ v1 v2, vrel r1 v1 v2 → vrel r2 v1 v2. Proof. intros Le v1 v2 VREL. by apply (Forall2_impl _ _ _ _ VREL), arel_mono. Qed. Lemma rrel_mono (r1 r2 : resUR) (VAL: ✓ r2) : r1 ≼ r2 → ∀ v1 v2, rrel r1 v1 v2 → rrel r2 v1 v2. Proof. intros Le v1 v2. destruct v1, v2; simpl; [|done..|]. - by apply vrel_mono. - intros [VREL ?]. split; [|done]. move : VREL. by apply vrel_mono. Qed. Lemma priv_loc_mono (r1 r2 : resUR) (VAL: ✓ r2) : r1 ≼ r2 → ∀ l t, priv_loc r1 l t → priv_loc r2 l t. Proof. ... ...
 ... ... @@ -9,9 +9,18 @@ Set Default Proof Using "Type". Section local. Context {A: ucmraT}. Variable (wsat: A → state → state → Prop). Variable (rrel: A → result → result → Prop). Variable (vrel: A → value → value → Prop). Variable (fs ft: fn_env). Definition rrel (r: A) rs rt: Prop := match rs, rt with | ValR vs, ValR vt => vrel r vs vt | PlaceR ls ts Ts, PlaceR lt t_t Tt => (* Places are related like pointers, and the types must be equal. *) vrel r [ScPtr ls ts] [ScPtr lt t_t] ∧ Ts = Tt | _, _ => False end. Notation PRED := (A → nat → result → state → result → state → Prop)%type. Notation SIM := (A → nat → expr → state → expr → state → PRED → Prop)%type. ... ... @@ -122,10 +131,10 @@ Definition fun_post (esat: A → call_id → Prop) initial_call_id_stack rrel r rs rt. Definition sim_local_fun (esat: A → call_id → Prop) (fn_src fn_tgt : function) : Prop := ∀ r es et (vl_src vl_tgt: list result) σs σt (VALEQ: Forall2 (rrel r) vl_src vl_tgt) (EQS: subst_l fn_src.(fun_args) (of_result <\$> vl_src) fn_src.(fun_body) = Some es) (EQT: subst_l fn_tgt.(fun_args) (of_result <\$> vl_tgt) fn_tgt.(fun_body) = Some et), ∀ r es et (vl_src vl_tgt: list value) σs σt (VALEQ: Forall2 (vrel r) vl_src vl_tgt) (EQS: subst_l fn_src.(fun_args) (Val <\$> vl_src) fn_src.(fun_body) = Some es) (EQT: subst_l fn_tgt.(fun_args) (Val <\$> vl_tgt) fn_tgt.(fun_body) = Some et), ∃ idx, sim_local_body r idx (InitCall es) σs (InitCall et) σt (fun_post esat σt.(scs)). ... ...
 ... ... @@ -46,15 +46,15 @@ Inductive sim_local_frames: our local resource r and have world satisfaction *) (WSAT' : wsat (r_f ⋅ (frame.(rc) ⋅ r')) σ_src' σ_tgt') (* and the returned values are related w.r.t. (r ⋅ r' ⋅ r_f) *) (VRET : rrel r' v_src v_tgt) (VRET : rrel vrel r' v_src v_tgt) (CIDS: σ_tgt'.(scs) = frame.(callids)), ∃ idx', sim_local_body wsat rrel fns fnt ∃ idx', sim_local_body wsat vrel fns fnt (frame.(rc) ⋅ r') idx' (fill frame.(K_src) (of_result v_src)) σ_src' (fill frame.(K_tgt) (of_result v_tgt)) σ_tgt' (λ r _ vs σs vt σt, (∃ c, σt.(scs) = c :: cids ∧ end_call_sat r c) ∧ rrel r vs vt)) rrel vrel r vs vt)) : sim_local_frames (r_f ⋅ frame.(rc)) frame.(callids) ... ... @@ -70,17 +70,17 @@ Inductive sim_local_conf: rc idx e_src σ_src e_tgt σ_tgt Ke_src Ke_tgt (FRAMES: sim_local_frames r_f cids K_src K_tgt frames) (LOCAL: sim_local_body wsat rrel fns fnt rc idx e_src σ_src e_tgt σ_tgt (LOCAL: sim_local_body wsat vrel fns fnt rc idx e_src σ_src e_tgt σ_tgt (λ r _ vs σs vt σt, (∃ c, σt.(scs) = c :: cids ∧ end_call_sat r c) ∧ rrel r vs vt)) rrel vrel r vs vt)) (KE_SRC: Ke_src = fill K_src e_src) (KE_TGT: Ke_tgt = fill K_tgt e_tgt) (WSAT: wsat (r_f ⋅ rc) σ_src σ_tgt) : sim_local_conf idx Ke_src σ_src Ke_tgt σ_tgt. Lemma sim_local_conf_sim (FUNS: sim_local_funs wsat rrel fns fnt end_call_sat) (FUNS: sim_local_funs wsat vrel fns fnt end_call_sat) (idx:nat) (e_src:expr) (σ_src:state) (e_tgt:expr) (σ_tgt:state) (SIM: sim_local_conf idx e_src σ_src e_tgt σ_tgt) : sim fns fnt idx (e_src, σ_src) (e_tgt, σ_tgt) ... ... @@ -134,7 +134,7 @@ Proof. simplify_eq. set Φ : resUR → nat → result → state → result → state → Prop := λ r2 _ vs2 σs2 vt2 σt2, rrel r2 vs2 vt2 ∧ λ r2 _ vs2 σs2 vt2 σt2, rrel vrel r2 vs2 vt2 ∧ ∃ c1 c2 cids1 cids2, σs.(scs) = c1 :: cids1 ∧ σt.(scs) = c2 :: cids2 ∧ σs2 = mkState σs.(shp) σs.(sst) cids1 σs.(snp) σs.(snc) ∧ ... ... @@ -206,12 +206,17 @@ Proof. destruct RED as (xls & ebs & HCs & ebss & Eqfs & Eqss & ? & ? & ?). subst e2 σ2. destruct (FUNS _ _ Eqfs) as ([xlt2 ebt2 HCt2] & Eqft2 & Eql2 & SIMf). rewrite Eqft2 in x3. simplify_eq. apply list_Forall_rrel_vrel in VREL as (vs & vt & ? & ? & VREL); [|done..]. subst vl_src vl_tgt. rewrite -list_fmap_compose in Eqss. rewrite -list_fmap_compose in x4. specialize (SIMf _ _ _ _ _ σ1_src σ_tgt VREL Eqss x4) as [idx2 SIMf]. esplits. * left. eapply tc_rtc_l. { apply fill_tstep_rtc. eauto. } { econs. rewrite -fill_app. eapply (head_step_fill_tstep). econs. eapply (CallBS _ _ _ _ xls ebs); eauto. } econs. eapply (CallBS _ _ _ _ xls ebs); eauto. rewrite -list_fmap_compose. eauto. } * right. apply CIH. econs. { econs 2; eauto. i. instantiate (1 := mk_frame _ _ _ _). ss. destruct (CONT r' v_src v_tgt σ_src' σ_tgt' VRET WSAT'). ... ...
 ... ... @@ -10,7 +10,7 @@ Theorem sim_prog_sim_classical prog_tgt `{NSD: stuck_decidable_1 prog_src} (MAINT: has_main prog_src) (FUNS: sim_local_funs wsat rrel prog_src prog_tgt end_call_sat) (FUNS: sim_local_funs wsat vrel prog_src prog_tgt end_call_sat) : behave_prog prog_tgt <1= behave_prog prog_src. Proof. destruct MAINT as (ebs & HCs & Eqs). ... ... @@ -32,7 +32,7 @@ Proof. intros. simpl. exists 1%nat. apply sim_body_result. intros VALID. have ?: rrel (init_res ⋅ r') vs vt. have ?: rrel vrel (init_res ⋅ r') vs vt. { eapply rrel_mono; [done|apply cmra_included_r|exact VRET]. } split; [|done]. exists O. split; [by rewrite -STACKT|]. ... ...
 ... ... @@ -47,12 +47,12 @@ Context (css cst: call_id_stack). Definition sem_steps := 10%nat. Definition sem_post (r: resUR) (n: nat) rs css' rt cst': Prop := n = sem_steps ∧ css' = css ∧ cst' = cst ∧ rrel r rs rt. n = sem_steps ∧ css' = css ∧ cst' = cst ∧ rrel vrel r rs rt. (** We define a "semantic well-formedness", in some context. *) Definition sem_wf (r: resUR) es et := ∀ xs : list (string * (result * result)), Forall (λ '(_, (rs, rt)), rrel r rs rt) xs → Forall (λ '(_, (rs, rt)), rrel vrel r rs rt) xs → r ⊨ˢ{sem_steps,fs,ft} (subst_map (prod_map id fst <\$> xs) es, css) ≥ ... ...
 ... ... @@ -1138,7 +1138,7 @@ Qed. (** EndCall *) Lemma end_call_tstep_src_tgt fs ft r_f r σs σt (rs rt: result) es' σs' : rrel r rs rt → rrel vrel r rs rt → wsat (r_f ⋅ r) σs σt → (EndCall rs, σs) ~{fs}~> (es', σs') → ∃ vs vt : value, rs = ValR vs ∧ rt = ValR vt ∧ reducible ft (EndCall rt) σt. ... ... @@ -1158,7 +1158,7 @@ Qed. Lemma sim_body_end_call fs ft r n rs rt σs σt Φ : (* return values are related *) rrel r rs rt → rrel vrel r rs rt → (* The top of the call stack has no privately protected locations left *) (∃ c cids, σt.(scs) = c :: cids ∧ end_call_sat r c) → (∀ c1 c2 cids1 cids2 vs vt, ... ... @@ -1281,7 +1281,7 @@ Lemma sim_body_step_over_call fs ft rc rv n fid vls vlt σs σt Φ (VREL: Forall2 (vrel rv) vls vlt) (FUNS: sim_local_funs_lookup fs ft) : (∀ r' vs vt σs' σt' (VRET: rrel r' vs vt) (∀ r' vs vt σs' σt' (VRET: rrel vrel r' vs vt) (STACKS: σs.(scs) = σs'.(scs)) (STACKT: σt.(scs) = σt'.(scs)), ∃ n', rc ⋅ r' ⊨{n',fs,ft} (of_result vs, σs') ≥ (of_result vt, σt') : Φ) → ... ... @@ -1314,6 +1314,15 @@ Proof. by rewrite Eqcss' Eqcss. Qed. Lemma sim_body_var fs ft r n σs σt var Φ : r ⊨{n,fs,ft} (Var var, σs) ≥ (Var var, σt) : Φ. Proof. pfold. intros NT r_f WSAT. destruct (NT (Var var) σs) as [[]|[? [? RED%tstep_var_inv]]]; [constructor|done..]. Qed. (** Let *) Lemma sim_body_let fs ft r n x es1 es2 et1 et2 σs σt Φ : terminal es1 → terminal et1 → ... ...
 ... ... @@ -13,7 +13,7 @@ From stbor.sim Require Import refl_step. Definition fun_post_simple initial_call_id_stack (r: resUR) (n: nat) vs (css: call_id_stack) vt cst := (∃ c, cst = c::initial_call_id_stack ∧ end_call_sat r c) ∧ rrel r vs vt. rrel vrel r vs vt. Definition sim_simple fs ft r n es css et cst (Φ : resUR → nat → result → call_id_stack → result → call_id_stack → Prop) : Prop := ... ... @@ -71,8 +71,8 @@ Proof. destruct vls as [|vs []]; [done| |done]. destruct vlt as [|vt []]; [done| |done]. inversion FREL as [|???? RREL]. intros _ _. simplify_eq. (* eapply sim_simplify; last by eapply HH. done. *) Admitted. eapply sim_simplify; last by eapply HH. done. Qed. Lemma sim_simple_bind fs ft (Ks: list (ectxi_language.ectx_item (bor_ectxi_lang fs))) ... ... @@ -119,7 +119,7 @@ Lemma sim_simple_call n' vls vlt rv fs ft r r' n fid css cst Φ : sim_local_funs_lookup fs ft → Forall2 (vrel rv) vls vlt → r ≡ r' ⋅ rv → (∀ rret vs vt, rrel rret vs vt → (∀ rret vs vt, rrel vrel rret vs vt → r' ⋅ rret ⊨ˢ{n',fs,ft} (of_result vs, css) ≥ (of_result vt, cst) : Φ) → r ⊨ˢ{n,fs,ft} (Call #[ScFnPtr fid] (Val <\$> vls), css) ≥ (Call #[ScFnPtr fid] (Val <\$> vlt), cst) : Φ. ... ...
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!