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

coq/Infra/Ltacs.v

@@ -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

coq/Infra/NatSet.v

@@ -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.