End UniqDerived.
(* *********************************************************************** *)
(** * Tactic support for [binds] *)
(** [destruct_binds_hyp] and [destruct_binds_hyp_uniq] tactics decompose a hypotheses of the form [binds x a E], with the latter tactic assuming that [uniq E] holds.  The tactic [solve_uniq] is used for discharging any [uniq] obligations that arise.  Implementation note (BEA, XXX): No support for [map].  I'm not sure what to do about the "injectivity" side condition on [binds_map_inv].  Perhaps just generate the extra subgoal, on the assumption that the condition is usually provable?  It's not as if I want to implement even more tactics here... *)
Ltac destruct_binds_hyp H :=
match type of H with
| binds ?x ?a nil =>
inversion H
| binds ?x ?a (?y ~ ?b) =>
let J1 := fresh "BindsTacKey" in
let J2 := fresh "BindsTacVal" in
rename H into J1;
pose proof J1 as J2;
apply binds_one_1 in J1;
apply binds_one_2 in J2;
try (subst x);
try (subst a);
try (subst y);
try (subst b)
| binds ?x ?a ((?y, ?b) :: ?E) =>
change (binds x a (y ~ b ++ E)) in H;
destruct_binds_hyp H
| binds ?x ?a (?E ++ ?F) =>
let J := fresh "BindsTac" in
apply binds_app_1 in H;
destruct H as [J | J];
destruct_binds_hyp J
| _ =>
idtac
end.
Ltac destruct_binds_hyp_uniq H :=
match type of H with
| binds ?x ?a nil =>
inversion H
| binds ?x ?a (?y ~ ?b) =>
let J1 := fresh "BindsTacKey" in
let J2 := fresh "BindsTacVal" in
rename H into J1;
pose proof J1 as J2;
apply binds_one_1 in J1;
apply binds_one_2 in J2;
try (subst x);
try (subst a);
try (subst y);
try (subst b)
| binds ?x ?a ((?y, ?b) :: ?E) =>
change (binds x a (y ~ b ++ E)) in H;
destruct_binds_hyp_uniq H
| binds ?x ?a (?E ++ ?F) =>
let J1 := fresh "BindsTacSideCond" in
assert (J1 : uniq (E ++ F));
[ destruct_uniq; auto
| match type of J1 with
| @uniq ?A _ =>
let J2 := fresh "BindsTac" in
destruct (@binds_app_uniq_1 A x a E F J1 H)
as [[J2 ?] | [J2 ?]];
clear H;
destruct_binds_hyp_uniq J2
end
]
| _ =>
idtac
end.
(** An auxiliary tactic.  Not intended for use on its own. *)
Ltac analyze_binds_cleanup :=
auto;
try tauto;
try discriminate;
try match goal with
| J : ~ In ?x ?E |- _ =>
match E with
| context [x] => elim J; clear; simpl_env; auto with set
end
end.
(** The [analyze_binds] and [analyze_binds_uniq] tactics decompose a hypothesis of the form [binds x a E], with the latter assuming that [uniq E] holds, and then try some simple heuristics for solving the resulting goals. *)
Ltac analyze_binds H :=
destruct_binds_hyp H;
analyze_binds_cleanup.
Ltac analyze_binds_uniq H :=
destruct_binds_hyp_uniq H;
analyze_binds_cleanup.
(* *********************************************************************** *)
(** * Facts about [binds] *)
Section BindsDerived.
Variables A B   : Type.
Variables f     : A -> B.
Variables x y   : atom.
Variables a b   : A.
Variables E F G : list (atom*A).

(* Specifications: *)
Axiom binds_dec :
(forall a b : A, {a = b} + {a <> b}) ->
{binds x a E} + {~ binds x a E}.
Axiom binds_lookup :
{a : A | binds x a E} + (forall a, ~ binds x a E).
Axiom binds_lookup_dec :
decidable (exists a, binds x a E).
Axiom binds_weaken :
binds x a (E ++ G) ->
binds x a (E ++ F ++ G).
Axiom binds_mid_eq :
binds x a (F ++ (x ~ b) ++ E) ->
uniq (F ++ (x ~ b) ++ E) ->
a = b.
Axiom binds_remove_mid :
binds x a (F ++ (y ~ b) ++ G) ->
x <> y ->
binds x a (F ++ G).
Axiom binds_In : forall x a (E : list (atom*A)),
binds x a E ->
In x (dom E).
Axiom binds_In_inv : forall x (E : list (atom*A)),
In x (dom E) ->
exists a, binds x a E.
Axiom binds_unique :
binds x a E ->
binds x b E ->
uniq E ->
a = b.
Axiom fresh_app_l :
uniq (F ++ E) ->
binds x a E ->
~ In x (dom F).
Axiom fresh_app_r :
uniq (F ++ E) ->
binds x a F ->
~ In x (dom E).