Commit eba7639e by Dan Frumin

### Tactic for solving typeability

```- Change the types in the examples slightly
- Use notations in the examples
- Modify some tactics to make the proofs more smooth```
parent 67d0a0ab
 ... ... @@ -14,17 +14,18 @@ Definition CG_increment : val := λ: "x" "l" <>, Definition counter_read : val := λ: "x" <>, !"x". Definition CG_counter : expr := let: "l" := newlock in Definition CG_counter : val := λ: <>, let: "l" := newlock #() in let: "x" := ref (#n 0) in (CG_increment "x" "l", counter_read "x"). Definition FG_increment : val := λ: "v", rec: "inc" <> := Let "c" (!"v") (If (CAS "v" "c" (BinOp Add (#n 1) "c")) (Unit) ("inc" #())). let: "c" := !"v" in if: CAS "v" "c" (BinOp Add (#n 1) "c") then #() else "inc" #(). Definition FG_counter : expr := Definition FG_counter : val := λ: <>, let: "x" := Alloc (#n 0) in (FG_increment "x", counter_read "x"). ... ... @@ -34,10 +35,7 @@ Section CG_Counter. (* Coarse-grained increment *) Lemma CG_increment_type Γ : typed Γ CG_increment (TArrow (Tref TNat) (TArrow LockType (TArrow TUnit TUnit))). Proof. unfold CG_increment. unlock. eauto 25 with typeable. Qed. Proof. solve_typed. Qed. Hint Resolve CG_increment_type : typeable. ... ... @@ -64,29 +62,20 @@ Section CG_Counter. Lemma counter_read_type Γ : typed Γ counter_read (TArrow (Tref TNat) (TArrow TUnit TNat)). Proof. unfold counter_read. unlock. eauto 10 with typeable. Qed. Proof. solve_typed. Qed. Hint Resolve counter_read_type : typeable. Lemma CG_counter_type Γ : typed Γ CG_counter (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)). Proof. unfold CG_counter. eauto 15 with typeable. Qed. typed Γ CG_counter (TArrow TUnit (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat))). Proof. solve_typed. Qed. Hint Resolve CG_counter_type : typeable. (* Fine-grained increment *) Lemma FG_increment_type Γ : typed Γ FG_increment (TArrow (Tref TNat) (TArrow TUnit TUnit)). Proof. unfold FG_increment. unlock. eauto 20 with typeable. Qed. Proof. solve_typed. Qed. Hint Resolve FG_increment_type : typeable. ... ... @@ -120,11 +109,8 @@ Section CG_Counter. Qed. Lemma FG_counter_type Γ : typed Γ FG_counter (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)). Proof. unfold FG_counter. eauto 15 with typeable. Qed. typed Γ FG_counter (TArrow TUnit (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat))). Proof. solve_typed. Qed. Hint Resolve FG_counter_type : typeable. ... ... @@ -133,7 +119,6 @@ Section CG_Counter. Definition counter_inv l cnt cnt' : iProp Σ := (∃ n, l ↦ₛ (#♭v false) ∗ cnt ↦ᵢ (#nv n) ∗ cnt' ↦ₛ (#nv n))%I. Lemma bin_log_counter_read_r Γ E1 E2 K x n t τ (Hspec : nclose specN ⊆ E1) : x ↦ₛ (#nv n) ... ... @@ -273,17 +258,19 @@ Section CG_Counter. Qed. Lemma FG_CG_counter_refinement : ∅ ⊨ FG_counter ≤log≤ CG_counter : TProd (TArrow TUnit TUnit) (TArrow TUnit TNat). ∅ ⊨ FG_counter ≤log≤ CG_counter : TArrow TUnit (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)). Proof. unfold FG_counter, CG_counter. rel_bind_r newlock. iApply bin_log_related_arrow; try by (unlock; eauto). iAlways. iIntros (? [? ?]) "/= [% %]"; simplify_eq/=. unlock. rel_rec_l. rel_rec_r. rel_bind_r (newlock #())%E. iApply (bin_log_related_newlock_r); auto; simpl. iIntros (l) "Hl". rel_rec_r. rel_alloc_r as cnt' "Hcnt'". rel_bind_l (Alloc _). iApply (bin_log_related_alloc_l); auto; simpl. iModIntro. iIntros (cnt) "Hcnt". rel_alloc_l as cnt "Hcnt". simpl. rel_rec_l. rel_rec_r. ... ... @@ -312,7 +299,7 @@ End CG_Counter. Theorem counter_ctx_refinement : ∅ ⊨ FG_counter ≤ctx≤ CG_counter : TProd (TArrow TUnit TUnit) (TArrow TUnit TNat). TArrow TUnit (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)). Proof. eapply (logrel_ctxequiv logrelΣ); [solve_closed.. | intros ]. apply FG_CG_counter_refinement. ... ...
 ... ... @@ -51,7 +51,7 @@ Section Refinement. unfold rand. unlock. simpl. rel_rec_l. rel_bind_l (Alloc _). iApply bin_log_related_alloc_l'; first eauto. iIntros (y) "Hy". simpl. iApply bin_log_related_alloc_l'; first eauto. iNext. iIntros (y) "Hy". simpl. rel_rec_l. iMod (inv_alloc choiceN _ (∃ b, y ↦ᵢ (#♭v b))%I with "[Hy]") as "#Hinv". { iNext. eauto. } ... ... @@ -89,7 +89,7 @@ Section Refinement. rel_fork_r as j "Hj". rel_rec_r. destruct b. - iApply fupd_logrel'. tp_store j. iModIntro. - tp_store j. by rel_load_r. - by rel_load_r. Qed. ... ...
 ... ... @@ -3,51 +3,40 @@ From iris_logrel.F_mu_ref_conc Require Import tactics rel_tactics. From iris_logrel.F_mu_ref_conc Require Export rules_binary typing fundamental_binary relational_properties notation. From iris.base_logic Require Import namespaces. (** [newlock = alloc false] *) Definition newlock : expr := Alloc (#♭ false). (** [acquire = λ x. if cas(x, false, true) then #() else acquire(x) ] *) Definition acquire : val := RecV "acquire" "x" (If (CAS "x" (#♭ false) (#♭ true)) (Unit) (App "acquire" "x")). (** [release = λ x. x <- false] *) Definition release : val := LamV "x" (Store "x" (#♭ false)). (** [with_lock e l = λ x. (acquire l) ;; e x ;; (release l)] *) Definition newlock : val := λ: <>, ref (#♭ false). Definition acquire : val := rec: "acquire" "x" := if: CAS "x" (#♭ false) (#♭ true) then #() else "acquire" "x". Definition release : val := λ: "x", "x" <- #♭ false. Definition with_lock : val := λ: "e" "l" "x", acquire "l";; Let "v" ("e" "x") (release "l";; "v"). Instance newlock_closed: Closed ∅ newlock. Proof. rewrite /newlock. solve_closed. Qed. let: "v" := "e" "x" in release "l";; "v". Definition LockType := Tref TBool. Hint Unfold LockType : typeable. Lemma newlock_type Γ : typed Γ newlock LockType. Proof. eauto with typeable. Qed. Lemma newlock_type Γ : typed Γ newlock (TArrow TUnit LockType). Proof. solve_typed. Qed. Hint Resolve newlock_type : typeable. Lemma acquire_type Γ : typed Γ acquire (TArrow LockType TUnit). Proof. unfold acquire. eauto 10 with typeable. Qed. Proof. solve_typed. Qed. Lemma release_type Γ : typed Γ release (TArrow LockType TUnit). Proof. unfold release. eauto with typeable. Qed. Hint Resolve acquire_type : typeable. Opaque acquire. Opaque release. Lemma release_type Γ : typed Γ release (TArrow LockType TUnit). Proof. solve_typed. Qed. Hint Resolve newlock_type : typeable. Hint Resolve release_type : typeable. Hint Resolve acquire_type : typeable. Lemma with_lock_type Γ τ τ' : typed Γ with_lock (TArrow (TArrow τ τ') (TArrow LockType (TArrow τ τ'))). Proof. unfold with_lock. unlock. eauto 25 with typeable. Qed. Proof. solve_typed. Qed. Hint Resolve with_lock_type : typeable. ... ... @@ -57,10 +46,12 @@ Section proof. Lemma steps_newlock ρ j K (Hcl : nclose specN ⊆ E1) : spec_ctx ρ -∗ j ⤇ fill K newlock spec_ctx ρ -∗ j ⤇ fill K (newlock #())%E ={E1}=∗ ∃ l, j ⤇ fill K (Loc l) ∗ l ↦ₛ (#♭v false). Proof. iIntros "#Hspec Hj". unfold newlock. unlock. tp_rec j. simpl. tp_alloc j as l "Hl". tp_normalise j. by iExists _; iFrame. Qed. ... ... @@ -68,10 +59,11 @@ Section proof. Lemma bin_log_related_newlock_r Γ K t τ (Hcl : nclose specN ⊆ E1) : (∀ l : loc, l ↦ₛ (#♭v false) -∗ {E1,E2;Γ} ⊨ t ≤log≤ fill K (Loc l) : τ)%I -∗ {E1,E2;Γ} ⊨ t ≤log≤ fill K newlock : τ. -∗ {E1,E2;Γ} ⊨ t ≤log≤ fill K (newlock #())%E: τ. Proof. iIntros "Hlog". unfold newlock. unfold newlock. unlock. rel_rec_r. rel_alloc_r as l "Hl". iApply ("Hlog" with "Hl"). Qed. ... ... @@ -85,7 +77,7 @@ Section proof. ={E1}=∗ j ⤇ fill K (Lit Unit) ∗ l ↦ₛ (#♭v true). Proof. iIntros "#Hspec Hl Hj". unfold acquire. unfold acquire. unlock. tp_rec j. tp_cas_suc j. tp_if_true j. ... ... @@ -99,6 +91,7 @@ Section proof. -∗ {E1,E2;Γ} ⊨ t ≤log≤ fill K (App acquire (Loc l)) : τ. Proof. iIntros "Hl Hlog". unfold acquire. unlock. rel_rec_r. rel_cas_suc_r. simpl. rel_if_r. ... ... @@ -113,7 +106,7 @@ Section proof. spec_ctx ρ -∗ l ↦ₛ (#♭v b) -∗ j ⤇ fill K (App release (Loc l)) ={E1}=∗ j ⤇ fill K (Lit Unit) ∗ l ↦ₛ (#♭v false). Proof. iIntros "#Hspec Hl Hj". unfold release. iIntros "#Hspec Hl Hj". unfold release. unlock. tp_rec j. tp_store j. tp_normalise j. by iFrame. ... ... @@ -126,7 +119,7 @@ Section proof. -∗ {E1,E2;Γ} ⊨ t ≤log≤ fill K (App release (Loc l)) : τ. Proof. iIntros "Hl Hlog". unfold release. unfold release. unlock. rel_rec_r. rel_store_r. by iApply "Hlog". ... ... @@ -144,7 +137,7 @@ Section proof. ={E1}=∗ j ⤇ fill K (of_val v) ∗ Q ∗ l ↦ₛ (#♭v false). Proof. iIntros (Hev Hpf ?) "#Hspec HP Hl Hj". unfold with_lock. unlock. (* TODO :( *) unfold with_lock. unlock. tp_rec j. tp_rec j. tp_rec j; eauto using to_of_val. ... ...
 ... ... @@ -21,10 +21,7 @@ Lemma par_type Γ τ1 τ2 : typed Γ par (TArrow (TArrow TUnit τ1) (TArrow (TArrow TUnit τ2) (TProd τ1 τ2))). Proof. unfold par. unlock. eauto 40 with typeable. Qed. Proof. solve_typed. Qed. Hint Resolve par_type : typeable. ... ... @@ -43,4 +40,5 @@ Section compatibility. iApply (bin_log_related_app with "[] He1"). iApply binary_fundamental_masked; eauto with typeable. Qed. End compatibility.
 ... ... @@ -319,7 +319,7 @@ Section masked. Closed (dom _ Γ) e → Closed (dom _ Γ) e' → (↑ specN ⊆ E) → □ ({E,E;(Autosubst_Classes.subst (ren (+1)) <\$> Γ)} ⊨ e ≤log≤ e' : τ) -∗ □ ({E,E;Autosubst_Classes.subst (ren (+1)) <\$> Γ} ⊨ e ≤log≤ e' : τ) -∗ {E,E;Γ} ⊨ TLam e ≤log≤ TLam e' : TForall τ. Proof. rewrite bin_log_related_eq. ... ... @@ -515,8 +515,8 @@ Section masked. iInv (logN .@ (l,l')) as ([v v']) "[Hv1 [>Hv2 #Hv]]" "Hclose". iModIntro. iApply (wp_store with "Hv1"); auto using to_of_val. iNext. iIntros "Hw2". tp_store j; eauto; tp_normalise j. iNext. iIntros "Hw2". tp_store j. iMod ("Hclose" with "[Hw2 Hv2]"). { iNext; iExists (_, _); simpl; iFrame. iFrame "IH2". } iExists UnitV; iFrame; auto. ... ...
 ... ... @@ -304,7 +304,7 @@ Lemma tac_rel_alloc_l `{logrelG Σ} nam nam_cl Δ1 Δ2 E1 E2 p i1 N P e' v' K' envs_lookup nam_cl Δ1 = None → nam_cl ≠ nam → Δ2 = envs_snoc (envs_snoc Δ1 false nam (▷ P)%I) false nam_cl (▷ P ={E1 ∖ ↑N,E1}=∗ True)%I → (Δ2 ⊢ |={E2}=> ∀ l, (Δ2 ⊢ |={E2}=> ▷ ∀ l, (l ↦ᵢ v' -∗ bin_log_related E2 E1 Γ (fill K' (Loc l)) t τ)) → (Δ1 ⊢ bin_log_related E1 E1 Γ e t τ). Proof. ... ... @@ -347,25 +347,27 @@ Tactic Notation "rel_alloc_l" "under" constr(N) "as" constr(nam) constr(nam_cl) Lemma tac_rel_alloc_l_simp `{logrelG Σ} Δ1 Δ2 E1 e' v' K' Γ e t τ : e = fill K' (Alloc e') → IntoLaterNEnvs 1 Δ1 Δ2 → to_val e' = Some v' → (Δ1 ⊢ ∀ l, (Δ2 ⊢ ∀ l, (l ↦ᵢ v' -∗ bin_log_related E1 E1 Γ (fill K' (Loc l)) t τ)) → (Δ1 ⊢ bin_log_related E1 E1 Γ e t τ). Proof. intros ???. subst e. rewrite -(bin_log_related_alloc_l' Γ E1). 2: eassumption. done. rewrite into_laterN_env_sound /=. rewrite -(bin_log_related_alloc_l' Γ E1); eauto. apply uPred.later_mono. Qed. Tactic Notation "rel_alloc_l" "as" ident(l) constr(H) := iStartProof; eapply (tac_rel_alloc_l_simp); [tac_bind_helper (* e = fill K' .. *) |apply _ (* IntoLaterNEnvs _ _ _ *) |solve_to_val (* to_val e' = Some v *) |iIntros (l) H (* new goal *)]. Lemma tac_rel_load_l `{logrelG Σ} nam nam_cl Δ1 Δ2 E1 E2 p i1 N P l K' Γ e t τ : nclose N ⊆ E1 → envs_lookup i1 Δ1 = Some (p, inv N P) → ... ... @@ -436,8 +438,8 @@ Tactic Notation "rel_load_l" := iStartProof; eapply (tac_rel_alloc_l_simp); [tac_bind_helper (* e = fill K' .. *) |apply _ (* IntoLaterNenvs 1 Δ1 Δ2 *) |iAssumptionCore || fail 3 "rel_load_l: cannot find ? ↦ᵢ ?" |apply _ (* IntoLaterNenvs _ Δ1 Δ2 *) |iAssumptionCore || fail 3 "rel_load_l: cannot find ? ↦ᵢ ?" | (* new goal *)]. Lemma tac_rel_store_l `{logrelG Σ} nam nam_cl Δ1 Δ2 E1 E2 p i1 N P l e' v' K' Γ e t τ : ... ...
 ... ... @@ -409,8 +409,8 @@ Section properties. Lemma bin_log_related_alloc_l Γ E1 E2 K e v t τ (Heval : to_val e = Some v) : (|={E1,E2}=> ∀ (l : loc), l ↦ᵢ v -∗ {E2,E1;Γ} ⊨ fill K (Loc l) ≤log≤ t : τ)%I (|={E1,E2}=> ▷ (∀ (l : loc), l ↦ᵢ v -∗ {E2,E1;Γ} ⊨ fill K (Loc l) ≤log≤ t : τ))%I -∗ {E1,E1;Γ} ⊨ fill K (Alloc e) ≤log≤ t : τ. Proof. iIntros "Hlog". ... ... @@ -421,7 +421,7 @@ Section properties. Lemma bin_log_related_alloc_l' Γ E K e v t τ (Heval : to_val e = Some v) : (∀ (l : loc), l ↦ᵢ v -∗ {E,E;Γ} ⊨ fill K (Loc l) ≤log≤ t : τ)%I ▷ (∀ (l : loc), l ↦ᵢ v -∗ {E,E;Γ} ⊨ fill K (Loc l) ≤log≤ t : τ)%I -∗ {E,E;Γ} ⊨ fill K (Alloc e) ≤log≤ t : τ. Proof. iIntros "Hlog". ... ...
 ... ... @@ -119,6 +119,16 @@ Hint Constructors EqType : typeable. Hint Extern 10 (<[_:=_]>_ !! _ = Some _) => eapply lookup_insert : typeable. Hint Extern 20 (<[_:=_]>_ !! _ = Some _) => rewrite lookup_insert_ne; last done : typeable. Lemma locked_val_typed Γ (v : val) (τ : type) : Γ ⊢ₜ of_val v : τ → Γ ⊢ₜ of_val (locked v) : τ. Proof. by unlock. Qed. Tactic Notation "solve_typed" int_or_var(n) := try apply locked_val_typed; eauto n with typeable. Tactic Notation "solve_typed" := solve_typed 50. (** Environment substitution and closedness *) Definition env_subst := subst_p. ... ...
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!