(* This file is distributed under the terms of the MIT License, also known as the X11 Licence.  A copy of this license is in the README file that accompanied the original distribution of this file.  Based on code written by: Brian Aydemir Aaron Bohannon Arthur Charg\'eraud Stephanie Weirich  With contributions from: Edsko de Vries: uniq_reorder_1, uniq_reorder_2, binds_In_inv *)
(** remove printing ~ *)
(** A library for "assumption" lists. *)
(* *********************************************************************** *)
(** * Implementation *)
(** Note that our library has an implicit convention for the "normal form" of an assumption list.  This normal form requires that a list be built only from [nil] (the empty list), [one] (the singleton list), and [app] (concatenation).  Additionally, concatenations should be associated to the right and the list should not contain any [nil] terms, unless it is the empty list itself.  This allows lists to be written in a slightly more uniform manner when compared to using both [cons] and [app] to build them.  The downsides are that Coq's [simpl] tactic will simplify instances of [one] down to [cons] and that there are instances in which one needs to write lists that are not in normal form (e.g., some concatenations will need to be associated to the left).  The [simpl_asnlist] and [rewrite_asnlist] tactics below are designed to minimize the impact of these downsides.  A [Strategy] declaration can be used to prevent Coq's tactics from simplifying [one], if one so desires. *)
(* Implementation note (BEA, XXX): Very little support for - Inversion on assumption lists when [one] is [opaque]. - No real support for [get]. - No real support for [maps]. - No support for permutations. *)
(* *********************************************************************** *)
(** * Assumptions *)
(** An assumption list is a list of assumptions.  Each assumption either maps a key to some value, or else is an arbitrary value.  Implementation note (BEA): We define this datatype here in order to take advantage of Coq's sort polymorphism. *)
Inductive general_asn (key A B : Type) : Type :=
| VarAsn : key -> A -> general_asn key A B
| AltAsn : B -> general_asn key A B.
Implicit Arguments VarAsn [key A].
Implicit Arguments AltAsn [B].
(* *********************************************************************** *)
(** * Beginning of the functor *)
Module Make
(X : UsualDecidableType)
(Import KeySet : FSetInterface.WSfun X).
Module Import D := CoqFSetDecide.WDecide_fun X KeySet.
Module KeySetProperties := FSetProperties.WProperties_fun X KeySet.
Module KeySetFacts := FSetFacts.WFacts_fun X KeySet.
(* *********************************************************************** *)
(** * Basic definitions *)
(** Implicit arguments are enabled for the following definitions. *)
Set Implicit Arguments.
(** An assumption maps an [atom] (sometimes called a 'key') to a value or else is simply a value (without any corresponding key).  A list of only [VarAsn]s can be thought of as an association list whose keys are [atom]s. *)
Local Notation asn := (general_asn X.t).
(** [one] constructs a singleton list.  We define an infix notation for it and ensure that the arguments to [app] are interpreted in the right scope, i.e., [list_scope].  Implementation note: The level associated with the notation gives it a higher precedence than the "++" notation for [app].  This should eliminate the need for parentheses.  See the definition below of [uniq], for example. *)
Definition one (C : Type) (item : C) : list C := cons item nil.
Notation "x ~ a :> B" :=
(one (VarAsn B x a))
(at level 50, a at next level)
: list_scope.
Notation "x ~ a" :=
(one (VarAsn _ x a))
(at level 50)
: list_scope.
Arguments Scope app [ type_scope list_scope list_scope ].
Open Scope list_scope.
(** [dom] computes the domain of an assumption list, i.e., the set consisting of its keys. *)
(* FIXME: commented out by simplicity, but the code should be fixed *)
(* Fixpoint dom (A B : Type) (E : list (asn A B)) : KeySet.t := match E with | nil => empty | VarAsn x _ :: E' => add x (dom E') | _ :: E' => dom E' end.  (** [get] looks up a key in the assumption list. *)
Fixpoint get
(A B : Type) (x : X.t) (E : list (asn A B))
: option A :=
match E with
| nil => None
| VarAsn y c :: F =>  if X.eq_dec x y then Some c else get x F
| _ :: F => get x F
end.
(** [binds] is a ternary predicate that holds when a key-value pair appears somewhere in the given assumption list. *)
Definition binds
(A B : Type) (x : X.t) (a : A) (E : list (asn A B))
: Prop :=
List.In (VarAsn _ x a) E.
(** [bindsAlt] is a binary predicate that holds when a key-less assumption appears somewhere in the given assumption list. *)
Definition bindsAlt
(A B : Type) (b : B) (E : list (asn A B))
: Prop :=
List.In (AltAsn _ _ b) E.
(** [maps] is a ternary predicate that holds when the first binding in the list for the given key is to the given value. *)
Definition maps
(A B : Type) (x : X.t) (a : A) (E : list (asn A B))
: Prop :=
get x E = Some a.
(** [disjoint] is a binary predicate that holds when the domains of two assumption lists are disjoint. *)
Definition disjoint
(A B C D : Type) (E : list (asn A B)) (F : list (asn C D))
: Prop :=
inter (dom E) (dom F) [<=] empty.
(** [map] applies a function to each of the values in an assumption list. *)
Definition map
(A B C D : Type) (f : A -> C) (g : B -> D) (E : list (asn A B))
: list (asn C D) :=
List.map (fun b => match b with
| VarAsn x a => VarAsn _ x (f a)
| AltAsn b => AltAsn _ _ (g b)
end) E.
(** [map_var] is like [map] except that it leave [AltAsn]s untouched. *)
Definition map_var
(A B C : Type) (f : A -> B) (E : list (asn A C))
: list (asn B C) :=
map f (fun x => x) E.
(** [erase_var] deletes all the variable mappings from an assumption list. *)
Fixpoint erase_var
(A B : Type) (E : list (asn A B))
: list B :=
match E with
| nil => nil
| VarAsn x a :: F => erase_var F
| AltAsn b :: F => b :: erase_var F
end.
(** [uniq] is unary predicate that holds if and only if each key is bound at most once in the given assumption list.  Note that [uniq] is defined in terms of [one], not [cons]. *)
Inductive uniq (A B : Type) : list (asn A B) -> Prop :=
| uniq_nil :
uniq nil
| uniq_push : forall x a E,
uniq E ->
~ In x (dom E) ->
uniq (x ~ a ++ E)
| uniq_alt : forall b E,
uniq E ->
uniq (one (AltAsn _ _ b) ++ E).
(** Unless stated otherwise, in the remainder of this file, implicit arguments will not be declared by default. *)
Unset Implicit Arguments.
(* *********************************************************************** *)
(** * List properties *)
(** The following properties are used mainly for rewriting assumption lists into the normal form described above.  See the [simpl_asnlist] and [rewrite_asnlist] tactics below. *)
Section ListProperties.
Variable  X : Type.
Variables x y : X.
Variables l l1 l2 l3 : list X.

(* Specifications: *)
Lemma cons_app_one :
cons x l = one x ++ l.
Lemma disjoint_cons_r :
forall A B C D x a (E : list (asn A B)) (F : list (asn C D)),
disjoint F (VarAsn _ x a :: E) <-> ~ In x (dom F) /\ disjoint E F.
Lemma disjoint_app_r :
forall A B C D (E F : list (asn A B)) (G : list (asn C D)),
disjoint G (E ++ F) <-> disjoint E G /\ disjoint F G.
Lemma uniq_one_alt_1 :
uniq (one (AltAsn _ A b)).
Lemma uniq_cons_1 :
uniq (VarAsn _ x a :: E) ->
uniq E.
Lemma uniq_cons_iff :
uniq (VarAsn _ x a :: E) <-> uniq E /\ ~ In x (dom E).
Lemma uniq_cons_alt_1 :
uniq (AltAsn _ _ b :: E) ->
uniq E.
Lemma uniq_cons_alt_iff :
uniq (AltAsn _ _ b :: E) <-> uniq E.
Lemma uniq_app_2 :
uniq (E ++ F) -> uniq F.
Lemma uniq_app_3 :
uniq (E ++ F) -> disjoint E F.
Lemma uniq_app_4 :
uniq E ->
uniq F ->
disjoint E F ->
uniq (E ++ F).
Lemma uniq_app_iff :
uniq (E ++ F) <-> uniq E /\ uniq F /\ disjoint E F.
Lemma uniq_map_1 :
uniq (map f g E) ->
uniq E.
Lemma uniq_map_2 :
uniq E ->
uniq (map f g E).
Lemma uniq_map_iff :
uniq (map f g E) <-> uniq E.
Lemma uniq_map_var_2 :
uniq E ->
uniq (map_var f E).
Lemma uniq_map_var_iff :
uniq (map_var f E) <-> uniq E.
Lemma binds_cons_1 :
binds x a (VarAsn _ y a' :: E) ->
(x = y /\ a = a') \/ binds x a E.
Lemma binds_cons_alt_1 :
binds x a (AltAsn _ _ b :: E) ->
binds x a E.
Lemma binds_map_2 :
binds x a E ->
binds x (f a) (map f g E).
Lemma binds_map_var_1 :
(forall a a', f a = f a' -> a = a') ->
binds x (f a) (map_var f E) ->
binds x a E.
Lemma binds_map_var_2 :
binds x a E ->
binds x (f a) (map_var f E).
Lemma binds_dom_contradiction : forall (E : list (asn A B)),
binds x a E ->
~ In x (dom E) ->
False.
Lemma binds_app_uniq_1 :
uniq (E ++ F) ->
binds x a (E ++ F) ->
(binds x a E /\ ~ In x (dom F)) \/ (binds x a F /\ ~ In x (dom E)).
Lemma binds_app_uniq_iff :
uniq (E ++ F) ->
(binds x a (E ++ F) <->
(binds x a E /\ ~ In x (dom F)) \/
(binds x a F /\ ~ In x (dom E))).