Commit b18b2448 authored by Dan Frumin's avatar Dan Frumin

Automate typing derivations

..by introducing a hint database for typeability
parent 9a90024f
...@@ -33,15 +33,17 @@ Section CG_Counter. ...@@ -33,15 +33,17 @@ Section CG_Counter.
Notation D := (prodC valC valC -n> iProp Σ). Notation D := (prodC valC valC -n> iProp Σ).
Implicit Types Δ : listC D. Implicit Types Δ : listC D.
(* Coarse-grained increment *) (* Coarse-grained increment *)
Lemma CG_increment_type Γ : Lemma CG_increment_type Γ :
typed Γ CG_increment (TArrow (Tref TNat) (TArrow TUnit TUnit)). typed Γ CG_increment (TArrow (Tref TNat) (TArrow TUnit TUnit)).
Proof. Proof.
unfold CG_increment. unlock. unfold CG_increment. unlock.
repeat econstructor; eauto; cbn; seq_map_lookup. eauto 10 with typeable.
Qed. Qed.
Hint Resolve CG_increment_type : typeable.
Lemma steps_CG_increment E ρ j K x n: Lemma steps_CG_increment E ρ j K x n:
nclose specN E nclose specN E
spec_ctx ρ - x ↦ₛ (#nv n) spec_ctx ρ - x ↦ₛ (#nv n)
...@@ -83,14 +85,11 @@ Section CG_Counter. ...@@ -83,14 +85,11 @@ Section CG_Counter.
typed Γ CG_locked_increment (TArrow (Tref TNat) (TArrow LockType (TArrow TUnit TUnit))). typed Γ CG_locked_increment (TArrow (Tref TNat) (TArrow LockType (TArrow TUnit TUnit))).
Proof. Proof.
unfold CG_locked_increment. unlock. unfold CG_locked_increment. unlock.
repeat econstructor; eauto; eauto 25 with typeable.
try (eapply with_lock_type); auto using CG_increment_type.
- cbn. rewrite lookup_insert_ne; eauto. rewrite lookup_insert_ne; eauto.
apply lookup_insert.
- cbn. apply lookup_insert.
- cbn. apply lookup_insert.
Qed. Qed.
Hint Resolve CG_locked_increment_type : typeable.
Lemma steps_CG_locked_increment E ρ j K x n l : Lemma steps_CG_locked_increment E ρ j K x n l :
nclose specN E nclose specN E
spec_ctx ρ - x ↦ₛ (#nv n) - l ↦ₛ (#v false) spec_ctx ρ - x ↦ₛ (#nv n) - l ↦ₛ (#v false)
...@@ -137,11 +136,11 @@ Section CG_Counter. ...@@ -137,11 +136,11 @@ Section CG_Counter.
typed Γ counter_read (TArrow (Tref TNat) (TArrow TUnit TNat)). typed Γ counter_read (TArrow (Tref TNat) (TArrow TUnit TNat)).
Proof. Proof.
unfold counter_read. unlock. unfold counter_read. unlock.
repeat econstructor. eauto 10 with typeable.
cbn. rewrite lookup_insert_ne; auto.
apply lookup_insert.
Qed. Qed.
Hint Resolve counter_read_type : typeable.
Lemma steps_counter_read E ρ j K x n : Lemma steps_counter_read E ρ j K x n :
nclose specN E nclose specN E
spec_ctx ρ - x ↦ₛ (#nv n) spec_ctx ρ - x ↦ₛ (#nv n)
...@@ -164,34 +163,30 @@ Section CG_Counter. ...@@ -164,34 +163,30 @@ Section CG_Counter.
(TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)))). (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)))).
Proof. Proof.
unfold CG_counter_body. unlock. unfold CG_counter_body. unlock.
repeat econstructor; eauto 15 with typeable.
eauto using CG_locked_increment_type, counter_read_type.
- cbn. rewrite lookup_insert_ne; auto.
apply lookup_insert.
- cbn. apply lookup_insert.
- cbn. rewrite lookup_insert_ne; auto.
apply lookup_insert.
Qed. Qed.
Hint Resolve CG_counter_body_type : typeable.
Lemma CG_counter_type Γ : Lemma CG_counter_type Γ :
typed Γ CG_counter (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)). typed Γ CG_counter (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)).
Proof. Proof.
econstructor; eauto using newlock_type. unfold CG_counter.
do 2 econstructor; [|do 2 constructor]. eauto 15 with typeable.
repeat econstructor; eauto. apply CG_counter_body_type; by constructor.
- apply lookup_insert.
- cbn. rewrite lookup_insert_ne; auto.
apply lookup_insert.
Qed. Qed.
Hint Resolve CG_counter_type : typeable.
(* Fine-grained increment *) (* Fine-grained increment *)
Lemma FG_increment_type Γ : Lemma FG_increment_type Γ :
typed Γ FG_increment (TArrow (Tref TNat) (TArrow TUnit TUnit)). typed Γ FG_increment (TArrow (Tref TNat) (TArrow TUnit TUnit)).
Proof. Proof.
unfold FG_increment. unlock. unfold FG_increment. unlock.
repeat (econstructor; eauto using EqTNat); cbn; try by seq_map_lookup. eauto 20 with typeable.
Qed. Qed.
Hint Resolve FG_increment_type : typeable.
Lemma bin_log_FG_increment_l Γ K E x n t τ : Lemma bin_log_FG_increment_l Γ K E x n t τ :
x ↦ᵢ (#nv n) - x ↦ᵢ (#nv n) -
(x ↦ᵢ (#nv (S n)) - {E,E;Γ} fill K (Lit Unit) log t : τ) - (x ↦ᵢ (#nv (S n)) - {E,E;Γ} fill K (Lit Unit) log t : τ) -
...@@ -269,18 +264,19 @@ Section CG_Counter. ...@@ -269,18 +264,19 @@ Section CG_Counter.
(TProd (TArrow TUnit TUnit) (TArrow TUnit TNat))). (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat))).
Proof. Proof.
unfold FG_counter_body. unlock. unfold FG_counter_body. unlock.
repeat econstructor; eauto; cbn; seq_map_lookup. eauto 15 with typeable.
- apply FG_increment_type; trivial.
- apply counter_read_type; trivial.
Qed. Qed.
Hint Resolve FG_counter_body_type : typeable.
Lemma FG_counter_type Γ : Lemma FG_counter_type Γ :
typed Γ FG_counter (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)). typed Γ FG_counter (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)).
Proof. Proof.
econstructor; eauto using newlock_type, typed. unfold FG_counter.
apply FG_counter_body_type; by constructor. eauto 15 with typeable.
Qed. Qed.
Hint Resolve FG_counter_type : typeable.
Definition counterN : namespace := nroot .@ "counter". Definition counterN : namespace := nroot .@ "counter".
......
...@@ -25,48 +25,32 @@ Proof. rewrite /newlock. solve_closed. Qed. ...@@ -25,48 +25,32 @@ Proof. rewrite /newlock. solve_closed. Qed.
Definition LockType := Tref TBool. Definition LockType := Tref TBool.
Hint Unfold LockType : typeable.
Lemma newlock_type Γ : typed Γ newlock LockType. Lemma newlock_type Γ : typed Γ newlock LockType.
Proof. repeat constructor. Qed. Proof. eauto with typeable. Qed.
Lemma acquire_type Γ : typed Γ acquire (TArrow LockType TUnit). Lemma acquire_type Γ : typed Γ acquire (TArrow LockType TUnit).
Proof. Proof. unfold acquire. eauto 10 with typeable. Qed.
do 3 econstructor; eauto using EqTBool; repeat constructor.
- by rewrite lookup_insert.
- rewrite lookup_insert_ne; eauto. by rewrite lookup_insert.
- by rewrite lookup_insert.
Qed.
Lemma release_type Γ : typed Γ release (TArrow LockType TUnit). Lemma release_type Γ : typed Γ release (TArrow LockType TUnit).
Proof. repeat econstructor. by rewrite lookup_insert. Qed. Proof. unfold release. eauto with typeable. Qed.
Opaque acquire. Opaque acquire.
Opaque release. Opaque release.
(* TODO: this lemma is not true without the assumption Hint Resolve newlock_type : typeable.
that x is not in Γ *) Hint Resolve release_type : typeable.
Lemma context_weaken_insert Γ x τ' e τ : Hint Resolve acquire_type : typeable.
Γ !! x = None
Γ ⊢ₜ e : τ
<[x:=τ']>Γ ⊢ₜ e : τ.
Proof.
intros Hx. eapply context_gen_weakening; eauto.
by apply insert_subseteq.
Qed.
Ltac seq_map_lookup :=
repeat lazymatch goal with
| [ |- <[?x:=_]>_ !! ?x = Some _ ] => rewrite lookup_insert; eauto
| [ |- <[?x:=_]>_ !! ?l = Some _ ] => rewrite lookup_insert_ne; eauto
end.
Lemma with_lock_type Γ τ τ' : Lemma with_lock_type Γ τ τ' :
typed Γ with_lock (TArrow (TArrow τ τ') (TArrow LockType (TArrow τ τ'))). typed Γ with_lock (TArrow (TArrow τ τ') (TArrow LockType (TArrow τ τ'))).
Proof. Proof.
unfold with_lock. unlock. unfold with_lock. unlock. eauto 25 with typeable.
do 3 (econstructor; eauto). cbn.
repeat (econstructor; eauto using release_type, acquire_type; cbn); seq_map_lookup.
Qed. Qed.
Hint Resolve with_lock_type : typeable.
Section proof. Section proof.
Context `{cfgSG Σ}. Context `{cfgSG Σ}.
Context `{heapIG Σ}. Context `{heapIG Σ}.
......
...@@ -79,6 +79,37 @@ Inductive typed (Γ : stringmap type) : expr → type → Prop := ...@@ -79,6 +79,37 @@ Inductive typed (Γ : stringmap type) : expr → type → Prop :=
Γ ⊢ₜ CAS e1 e2 e3 : TBool Γ ⊢ₜ CAS e1 e2 e3 : TBool
where "Γ ⊢ₜ e : τ" := (typed Γ e τ). where "Γ ⊢ₜ e : τ" := (typed Γ e τ).
(** A hint db for the typing information *)
Create HintDb typeable.
Hint Constructors typed : typeable.
(** we need to replace some of the constructors with lemmas better suitable for search *)
Lemma TCAS' Γ e1 e2 e3 τ :
Γ ⊢ₜ e1 : Tref τ Γ ⊢ₜ e2 : τ Γ ⊢ₜ e3 : τ
EqType τ
Γ ⊢ₜ CAS e1 e2 e3 : TBool.
Proof. eauto using TCAS. Qed.
Hint Resolve TCAS' : typeable.
Remove Hints TCAS : typeable.
Lemma BINOP' Γ op e1 e2 τ :
Γ ⊢ₜ e1 : TNat
Γ ⊢ₜ e2 : TNat
τ = binop_res_type op
Γ ⊢ₜ BinOp op e1 e2 : τ.
Proof. intros. subst τ. by econstructor. Qed.
Hint Resolve BINOP' : typeable.
Remove Hints BinOp_typed : typeable.
Hint Constructors EqType : typeable.
Hint Extern 10 (<[_:=_]>_ !! _ = Some _) => eapply lookup_insert : typeable.
Hint Extern 20 (<[_:=_]>_ !! _ = Some _) => rewrite lookup_insert_ne; last done : typeable.
(** Environment substitution and closedness *) (** Environment substitution and closedness *)
Definition env_subst := subst_p. Definition env_subst := subst_p.
...@@ -106,15 +137,12 @@ Proof. ...@@ -106,15 +137,12 @@ Proof.
- case_bool_decide; auto. - case_bool_decide; auto.
apply H0. apply H0.
rewrite elem_of_dom. by exists τ. rewrite elem_of_dom. by exists τ.
- destruct f, x; eauto; simpl. - revert IHtyped.
rewrite -(dom_insert _ _ τ1). eauto. rewrite !dom_insert_binder.
rewrite -(dom_insert _ _ (TArrow τ1 τ2)). eauto. destruct f, x; cbn-[union];
rewrite -(dom_insert _ s (TArrow τ1 τ2)). rewrite ?(left_id union); eauto.
rewrite -(dom_insert _ s0 τ1).
eauto.
- rewrite -dom_fmap. eassumption. - rewrite -dom_fmap. eassumption.
- apply andb_prop_intro; split; auto. - split_and?; [ | rewrite -dom_fmap ]; eauto.
rewrite -dom_fmap. eauto.
Qed. Qed.
(** Weakening *) (** Weakening *)
...@@ -124,14 +152,12 @@ Lemma context_gen_weakening Γ Δ e τ : ...@@ -124,14 +152,12 @@ Lemma context_gen_weakening Γ Δ e τ :
Δ ⊢ₜ e : τ. Δ ⊢ₜ e : τ.
Proof. Proof.
intros Hsub Ht. revert Hsub. generalize dependent Δ. intros Hsub Ht. revert Hsub. generalize dependent Δ.
induction Ht => Δ Hsub; subst; eauto using typed. induction Ht => Δ Hsub; subst; eauto with typeable.
- econstructor. - econstructor. by eapply lookup_weaken.
eapply lookup_weaken; eauto. - econstructor. eapply IHHt.
- econstructor. eapply IHHt.
destruct f, x; cbn; eauto; destruct f, x; cbn; eauto;
repeat eapply insert_mono; done. repeat eapply insert_mono; done.
- econstructor. - econstructor. eapply IHHt.
eapply IHHt.
by apply map_fmap_mono. by apply map_fmap_mono.
- econstructor. - econstructor.
* by eapply IHHt1. * by eapply IHHt1.
......
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