Set Implicit Arguments.
Set Strict Implicit.
Section pmap.
Variable T : Type.
Inductive pmap : Type :=
| Empty
| Branch : option T -> pmap -> pmap -> pmap.
Definition pmap_here (m : pmap) : option T :=
match m with
| Empty => None
| Branch d _ _ => d
end.
Definition pmap_left (m : pmap) : pmap :=
match m with
| Empty => Empty
| Branch _ l _ => l
end.
Definition pmap_right (m : pmap) : pmap :=
match m with
| Empty => Empty
| Branch _ _ r => r
end.
Fixpoint pmap_lookup (p : positive) (m : pmap) : option T :=
match m with
| Empty => None
| Branch d l r =>
match p with
| xH => d
| xO p => pmap_lookup p l
| xI p => pmap_lookup p r
end
end.
Fixpoint pmap_insert (p : positive) (v : T) (m : pmap) : pmap :=
match p with
| xH => Branch (Some v) (pmap_left m) (pmap_right m)
| xO p =>
Branch (pmap_here m) (pmap_insert p v (pmap_left m)) (pmap_right m)
| xI p =>
Branch (pmap_here m) (pmap_left m) (pmap_insert p v (pmap_right m))
end.
Definition branch (o : option T) (l r : pmap) : pmap :=
match o , l , r with
| None , Empty , Empty => Empty
| _ , _ , _ => Branch o l r
end.
Fixpoint pmap_remove (p : positive) (m : pmap) : pmap :=
match m with
| Empty => Empty
| Branch d l r =>
match p with
| xH => branch None l r
| xO p => branch d (pmap_remove p l) r
| xI p => branch d l (pmap_remove p r)
end
end.
Definition pmap_empty : pmap := Empty.
Fixpoint pmap_union (f m : pmap) : pmap :=
match f with
| Empty => m
| Branch d l r =>
Branch (match d with
| Some x => Some x
| None => pmap_here m
end) (pmap_union l (pmap_left m)) (pmap_union r (pmap_right m))
end.
Global Instance Map_pmap : Map positive T pmap :=
{ empty := pmap_empty
; add := pmap_insert
; remove := pmap_remove
; lookup := pmap_lookup
; union := pmap_union
}.

(* Specifications: *)
Lemma tilde_1_inj_neg : forall k k',
(k~1)%positive <> (k'~1)%positive -> k <> k'.
Lemma tilde_0_inj_neg : forall k k',
(k~0)%positive <> (k'~0)%positive -> k <> k'.
Lemma pmap_lookup_insert_empty : forall k k' v,
k <> k' ->
pmap_lookup k' (pmap_insert k v Empty) = None.
Lemma lookup_empty : forall k, pmap_lookup k Empty = None.
Hint Rewrite lookup_empty pmap_lookup_insert_empty
using (eauto using tilde_1_inj_neg, tilde_1_inj_neg) : pmap_rw.
Lemma pmap_lookup_insert_eq
: forall (m : pmap) (k : positive) (v : T),
pmap_lookup k (pmap_insert k v m) = Some v.
Lemma pmap_lookup_insert_Some_neq
: forall (m : pmap) (k : positive) (v : T) (k' : positive),
k <> k' ->
forall v' : T,
pmap_lookup k' m = Some v' <-> pmap_lookup k' (pmap_insert k v m) = Some v'.
Lemma pmap_lookup_insert_None_neq
: forall (m : pmap) (k : positive) (v : T) (k' : positive),
k <> k' ->
pmap_lookup k' m = None <-> pmap_lookup k' (pmap_insert k v m) = None.
Lemma pmap_lookup_insert_neq
: forall (m : pmap) (k : positive) (v : T) (k' : positive),
k <> k' ->
forall v' : T,
pmap_lookup k' (pmap_insert k v m) = pmap_lookup k' m.