You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
85 lines
3.7 KiB
85 lines
3.7 KiB
From stdpp Require Import gmap base relations.
|
|
From iris Require Import prelude.
|
|
From semantics.lib Require Export facts maps sets.
|
|
From semantics.ts.systemf_mu Require Export lang notation types.
|
|
|
|
Ltac map_solver :=
|
|
repeat match goal with
|
|
| |- (⤉ _) !! _ = Some _ =>
|
|
rewrite fmap_insert
|
|
| |- <[ ?p := _ ]> _ !! ?p = Some _ =>
|
|
apply lookup_insert
|
|
| |- <[ _ := _ ]> _ !! _ = Some _ =>
|
|
rewrite lookup_insert_ne; [ | congruence]
|
|
end.
|
|
Ltac solve_typing :=
|
|
intros;
|
|
repeat match goal with
|
|
| |- TY _ ; _ ⊢ ?e : ?A => first [eassumption | econstructor]
|
|
(* heuristic to solve tapp goals where we need to pick the right type for the substitution *)
|
|
| |- TY _ ; _ ⊢ ?e <> : ?A => eapply typed_tapp'; [solve_typing | | asimpl; reflexivity]
|
|
| |- TY _ ; _ ⊢ Unroll ?e : ?A => eapply typed_unroll'; [solve_typing | asimpl; reflexivity]
|
|
| |- bin_op_typed _ _ _ _ => econstructor
|
|
| |- un_op_typed _ _ _ _ => econstructor
|
|
| |- type_wf _ ?e => assert_fails (is_evar e); eassumption
|
|
| |- type_wf _ ?e => assert_fails (is_evar e); econstructor
|
|
| |- type_wf _ (subst _ ?A) => eapply type_wf_subst; [ | intros; simpl]
|
|
| |- type_wf _ ?e => assert_fails (is_evar e); eapply type_wf_mono; [eassumption | lia]
|
|
(* conditions spawned by the tyvar case of [type_wf] *)
|
|
| |- _ < _ => lia
|
|
(* conditions spawned by the variable case *)
|
|
| |- _ !! _ = Some _ => map_solver
|
|
end.
|
|
|
|
Tactic Notation "unify_type" uconstr(A) :=
|
|
match goal with
|
|
| |- TY ?n; ?Γ ⊢ ?e : ?B => unify A B
|
|
end.
|
|
Tactic Notation "replace_type" uconstr(A) :=
|
|
match goal with
|
|
| |- TY ?n; ?Γ ⊢ ?e : ?B => replace B%ty with A%ty; cycle -1; first try by asimpl
|
|
end.
|
|
|
|
|
|
Ltac simplify_list_elem :=
|
|
simpl;
|
|
repeat match goal with
|
|
| |- ?x ∈ ?y :: ?l => apply elem_of_cons; first [left; reflexivity | right]
|
|
| |- _ ∉ [] => apply not_elem_of_nil
|
|
| |- _ ∉ _ :: _ => apply not_elem_of_cons; split
|
|
end; try fast_done.
|
|
Ltac simplify_list_subseteq :=
|
|
simpl;
|
|
repeat match goal with
|
|
| |- ?x :: _ ⊆ ?x :: _ => apply list_subseteq_cons_l
|
|
| |- ?x :: _ ⊆ _ => apply list_subseteq_cons_elem; first solve [simplify_list_elem]
|
|
| |- elements _ ⊆ elements _ => apply elements_subseteq; set_solver
|
|
| |- [] ⊆ _ => apply list_subseteq_nil
|
|
| |- ?x :b: _ ⊆ ?x :b: _ => apply list_subseteq_cons_binder
|
|
(* NOTE: this might make the goal unprovable *)
|
|
(*| |- elements _ ⊆ _ :: _ => apply list_subseteq_cons_r*)
|
|
end;
|
|
try fast_done.
|
|
|
|
(* Try to solve [is_closed] goals using a number of heuristics (that shouldn't make the goal unprovable) *)
|
|
Ltac simplify_closed :=
|
|
simpl; intros;
|
|
repeat match goal with
|
|
| |- closed _ _ => unfold closed; simpl
|
|
| |- Is_true (is_closed [] _) => first [assumption | done]
|
|
| |- Is_true (is_closed _ (lang.subst _ _ _)) => rewrite subst_is_closed_nil; last solve[simplify_closed]
|
|
| |- Is_true (is_closed ?X ?v) => assert_fails (is_evar X); eapply is_closed_weaken
|
|
| |- Is_true (is_closed _ _) => eassumption
|
|
| |- Is_true (_ && true) => rewrite andb_true_r
|
|
| |- Is_true (true && _) => rewrite andb_true_l
|
|
| |- Is_true (?a && ?a) => rewrite andb_diag
|
|
| |- Is_true (_ && _) => simpl; rewrite !andb_True; split_and!
|
|
| |- _ ⊆ ?A => match type of A with | list _ => simplify_list_subseteq end
|
|
| |- _ ∈ ?A => match type of A with | list _ => simplify_list_elem end
|
|
| |- _ ≠ _ => congruence
|
|
| H : closed _ _ |- _ => unfold closed in H; simpl in H
|
|
| H: Is_true (_ && _) |- _ => simpl in H; apply andb_True in H
|
|
| H : _ ∧ _ |- _ => destruct H
|
|
| |- Is_true (bool_decide (_ ∈ _)) => apply bool_decide_pack; set_solver
|
|
end; try fast_done.
|