Section MapDefs.
(** We now define maps from ad to A. *)
Variable A : Type.
Inductive Map :=
| M0 : Map
| M1 : ad -> A -> Map
| M2 : Map -> Map -> Map.
(** The semantics of maps is given by the function [MapGet]. The semantics of a map [m] is a partial, finite function from [ad] to [A]: *)
Fixpoint MapGet (m:Map) : ad -> option A :=
match m with
| M0 => fun a:ad => None
| M1 x y => fun a:ad => if N.eqb x a then Some y else None
| M2 m1 m2 =>
fun a:ad =>
match a with
| N0 => MapGet m1 N0
| Npos xH => MapGet m2 N0
| Npos (xO p) => MapGet m1 (Npos p)
| Npos (xI p) => MapGet m2 (Npos p)
end
end.
Definition newMap := M0.
Definition MapSingleton := M1.
Definition eqm (g g':ad -> option A) := forall a:ad, g a = g' a.
Fixpoint MapPut1 (a:ad) (y:A) (a':ad) (y':A) (p:positive) {struct p} :
Map :=
match p with
| xO p' =>
let m := MapPut1 (N.div2 a) y (N.div2 a') y' p' in
match Nbit0 a with
| false => M2 m M0
| true => M2 M0 m
end
| _ =>
match Nbit0 a with
| false => M2 (M1 (N.div2 a) y) (M1 (N.div2 a') y')
| true => M2 (M1 (N.div2 a') y') (M1 (N.div2 a) y)
end
end.
(*i Lemma MapGet_M2_bit_0_1' : (m,m',m'',m''':Map) (a:ad) (MapGet (if (Nbit0 a) then (M2 m m') else (M2 m'' m''')) a)= (MapGet (if (Nbit0 a) then m' else m'') (Ndiv2 a)). i*)
Fixpoint MapPut (m:Map) : ad -> A -> Map :=
match m with
| M0 => M1
| M1 a y =>
fun (a':ad) (y':A) =>
match Nxor a a' with
| N0 => M1 a' y'
| Npos p => MapPut1 a y a' y' p
end
| M2 m1 m2 =>
fun (a:ad) (y:A) =>
match a with
| N0 => M2 (MapPut m1 N0 y) m2
| Npos xH => M2 m1 (MapPut m2 N0 y)
| Npos (xO p) => M2 (MapPut m1 (Npos p) y) m2
| Npos (xI p) => M2 m1 (MapPut m2 (Npos p) y)
end
end.
Fixpoint MapPut_behind (m:Map) : ad -> A -> Map :=
match m with
| M0 => M1
| M1 a y =>
fun (a':ad) (y':A) =>
match Nxor a a' with
| N0 => m
| Npos p => MapPut1 a y a' y' p
end
| M2 m1 m2 =>
fun (a:ad) (y:A) =>
match a with
| N0 => M2 (MapPut_behind m1 N0 y) m2
| Npos xH => M2 m1 (MapPut_behind m2 N0 y)
| Npos (xO p) => M2 (MapPut_behind m1 (Npos p) y) m2
| Npos (xI p) => M2 m1 (MapPut_behind m2 (Npos p) y)
end
end.
Definition makeM2 (m m':Map) :=
match m, m' with
| M0, M0 => M0
| M0, M1 a y => M1 (Ndouble_plus_one a) y
| M1 a y, M0 => M1 (N.double a) y
| _, _ => M2 m m'
end.
Fixpoint MapRemove (m:Map) : ad -> Map :=
match m with
| M0 => fun _:ad => M0
| M1 a y =>
fun a':ad => match N.eqb a a' with
| true => M0
| false => m
end
| M2 m1 m2 =>
fun a:ad =>
if Nbit0 a
then makeM2 m1 (MapRemove m2 (N.div2 a))
else makeM2 (MapRemove m1 (N.div2 a)) m2
end.
Fixpoint MapCard (m:Map) : nat :=
match m with
| M0 => 0
| M1 _ _ => 1
| M2 m m' => MapCard m + MapCard m'
end.
Fixpoint MapMerge (m:Map) : Map -> Map :=
match m with
| M0 => fun m':Map => m'
| M1 a y => fun m':Map => MapPut_behind m' a y
| M2 m1 m2 =>
fun m':Map =>
match m' with
| M0 => m
| M1 a' y' => MapPut m a' y'
| M2 m'1 m'2 => M2 (MapMerge m1 m'1) (MapMerge m2 m'2)
end
end.
(** [MapInter], [MapRngRestrTo], [MapRngRestrBy], [MapInverse] not implemented: need a decidable equality on [A]. *)
Fixpoint MapDelta (m:Map) : Map -> Map :=
match m with
| M0 => fun m':Map => m'
| M1 a y =>
fun m':Map =>
match MapGet m' a with
| None => MapPut m' a y
| _ => MapRemove m' a
end
| M2 m1 m2 =>
fun m':Map =>
match m' with
| M0 => m
| M1 a' y' =>
match MapGet m a' with
| None => MapPut m a' y'
| _ => MapRemove m a'
end
| M2 m'1 m'2 => makeM2 (MapDelta m1 m'1) (MapDelta m2 m'2)
end
end.

Lemma MapDelta_semantics :
forall m m':Map,
eqm (MapGet (MapDelta m m'))
(fun a0:ad =>
match MapGet m a0, MapGet m' a0 with
| None, Some y' => Some y'
| Some y, None => Some y
| _, _ => None
end).