Commit 41b255c9 authored by Heiko Becker's avatar Heiko Becker

Port interval validation to finite maps, simplify proofs on the way

parent 6350c89b
......@@ -21,11 +21,13 @@ Ltac canonize_Q_prop :=
match goal with
| [ H: Qle_bool ?a ?b = true |- _] => rewrite Qle_bool_iff in H
| [ H: Qleb ?a ?b = true |- _ ] => rewrite Qle_bool_iff in H
| [ H: Qeq_bool ?a ?b = true |- _] => rewrite Qeq_bool_iff in H
end.
Ltac canonize_Q_to_R :=
match goal with
| [ H: (?a <= ?b)%Q |- _ ] => apply Qle_Rle in H
| [ H: (?a == ?b)%Q |- _ ] => apply Qeq_eqR in H
| [ H: context [Q2R 0] |- _ ] => rewrite Q2R0_is_0 in H
| [ |- context [Q2R 0] ] => rewrite Q2R0_is_0
end.
......@@ -44,51 +46,72 @@ Ltac Q2R_to_head_step :=
Ltac Q2R_to_head := repeat Q2R_to_head_step.
Ltac NatSet_simp hyp :=
try rewrite NatSet.mem_spec in hyp;
try rewrite NatSet.equal_spec in hyp;
try rewrite NatSet.subset_spec in hyp;
try rewrite NatSet.empty_spec in hyp;
try rewrite NatSet.is_empty_spec in hyp;
try rewrite NatSet.add_spec in hyp;
try rewrite NatSet.remove_spec in hyp;
try rewrite NatSet.singleton_spec in hyp;
try rewrite NatSet.union_spec in hyp;
try rewrite NatSet.inter_spec in hyp;
try rewrite NatSet.diff_spec in hyp.
Ltac NatSet_prop :=
match goal with
| [ H : true = true |- _ ] => clear H; NatSet_prop
| [ H: ?T = true |- _ ] => NatSet_simp H;
(apply Is_true_eq_left in H; NatSet_prop; apply Is_true_eq_true in H) || NatSet_prop
| _ => try auto
Definition optionLift (X Y:Type) (v:option X) (f:X -> Y) (e:Y) :=
match v with
|Some val => f val
| None => e
end.
Ltac match_simpl :=
Lemma optionLift_eq (X Y:Type) v (f:X -> Y) (e:Y):
match v with |Some val => f val | None => e end = optionLift X Y v f e.
Proof.
cbv; auto.
Qed.
Lemma optionLift_cond X (a:bool) (b c :X):
(if a then b else c) = match a with |true => b |false => c end.
Proof.
cbv; auto.
Qed.
Ltac remove_matches := rewrite optionLift_eq in *.
Ltac remove_conds := rewrite <- andb_lazy_alt, optionLift_cond in *.
Ltac match_factorize :=
match goal with
| [ H: ?t = ?u |- context [match ?t with _ => _ end]] => rewrite H; simpl
| [ H: ?t = ?u |- context [optionLift _ _ ?t _ _]]
=> rewrite H; cbn
| [ H1: ?t = ?u, H2: context [optionLift _ _ ?t _ _] |- _ ]
=> rewrite H1 in H2; cbn in H2
| [ H: context [optionLift _ _ ?t _ _] |- _ ]
=> destruct t eqn:?; cbn in H; try congruence
| [ |- context [optionLift _ _ ?t _ _] ]
=> destruct t eqn:?; cbn; try congruence
end.
Ltac destruct_if :=
Ltac pair_factorize :=
match goal with
| [H: if ?c then ?a else ?b = _ |- _ ] =>
case_eq ?c;
let name := fresh "cond" in
intros name;
rewrite name in *;
try congruence
| [H: _ |- if ?c then ?a else ?b = _] =>
case_eq ?c;
let name := fresh "cond" in
intros name;
rewrite name in *;
try congruence
end.
(* HOL4 Style patter matching tactics *)
Tactic Notation "lift " tactic(t) :=
fun H => t H.
| [H: context[let (_, _) := ?p in _] |- _] => destruct p; cbn in H
end.
Ltac match_simpl :=
try remove_conds;
try remove_matches;
repeat match_factorize;
try pair_factorize.
(* Ltac destruct_if := *)
(* match goal with *)
(* | [H: if ?c then ?a else ?b = _ |- _ ] => *)
(* case_eq ?c; *)
(* let name := fresh "cond" in *)
(* intros name; *)
(* rewrite name in *; *)
(* try congruence *)
(* | [H: _ |- if ?c then ?a else ?b = _] => *)
(* case_eq ?c; *)
(* let name := fresh "cond" in *)
(* intros name; *)
(* rewrite name in *; *)
(* try congruence *)
(* end. *)
(* Ltac match_destr t:= *)
(* match goal with *)
(* | H: context [optionLift (DaisyMap.find ?k ?M) _ _] |- _ => *)
(* destruct (DaisyMap.find (elt:=intv * error) k M); idtac H *)
(* end. *)
Tactic Notation "match_pat" open_constr(pat) tactic(t) :=
match goal with
......
......@@ -72,24 +72,39 @@ Proof.
destruct x_in_add as [ x_eq | [x_neq x_in_S]]; auto.
Qed.
(** TODO: Merge with NatSet_prop tactic in Ltacs file **)
Ltac set_hnf_tac :=
Ltac set_bool_to_prop :=
match goal with
| [ H: NatSet.mem ?x _ = true |- _ ] => rewrite NatSet.mem_spec in H
| [ H: NatSet.mem ?x _ = false |- _] => apply not_in_not_mem in H
| [ |- context [NatSet.mem ?x _]] => rewrite NatSet.mem_spec
end.
Ltac solve_simple_sets :=
match goal with
| [ H: NatSet.In ?x ?S1 |- NatSet.In ?x (NatSet.union ?S1 ?S2)]
=> rewrite NatSet.union_spec; auto
end.
Ltac set_hnf_tac :=
match goal with
| [ H: context [NatSet.In ?x (NatSet.diff ?A ?B)] |- _] => rewrite NatSet.diff_spec in H; destruct H
| [ H: NatSet.Subset ?SA ?SB |- NatSet.In ?v ?SB] => apply H
| [ H: NatSet.In ?x (NatSet.singleton ?y) |- _] => apply NatSetProps.Dec.F.singleton_1 in H
| [ H: NatSet.In ?x NatSet.empty |- _ ] => inversion H
| [ H: NatSet.In ?x (NatSet.union ?S1 ?S2) |- _ ] => rewrite NatSet.union_spec in H
| [ H: NatSet.In ?x (NatSet.add ?y ?S) |- _ ] => rewrite NatSet.add_spec_strong in H
| [ |- context [NatSet.mem ?x _]] => rewrite NatSet.mem_spec
| [ H: NatSet.In ?x (NatSet.add ?y ?S) |- _ ] => rewrite add_spec_strong in H
| [ |- context [NatSet.In ?x (NatSet.union ?SA ?SB)]] => rewrite NatSet.union_spec
| [ |- context [NatSet.In ?x (NatSet.diff ?A ?B)]] => rewrite NatSet.diff_spec
| [ |- context [NatSet.In ?x (NatSet.singleton ?y)]] => rewrite NatSet.singleton_spec
| [ |- context [NatSet.In ?x (NatSet.remove ?y ?S)]] => rewrite NatSet.remove_spec
| [ |- context [NatSet.In ?x (NatSet.add ?y ?S)]] => rewrite NatSet.add_spec
| [ |- context [NatSet.Subset ?SA ?SB]] => hnf; intros
end.
Ltac set_tac :=
repeat set_hnf_tac;
simpl in *; try auto.
repeat set_bool_to_prop;
repeat solve_simple_sets;
repeat set_hnf_tac;
simpl in *;
repeat solve_simple_sets;
try auto.
This diff is collapsed.
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