Section Store.
Variable A:Type.
Notation Poption := (Poption A).
Notation Tree := (Tree A).
Fixpoint Tget (p:positive) (T:Tree) {struct p} : Poption :=
match T with
Tempty => PNone
| Branch0 T1 T2 =>
match p with
xI pp => Tget pp T2
| xO pp => Tget pp T1
| xH => PNone
end
| Branch1 a T1 T2 =>
match p with
xI pp => Tget pp T2
| xO pp => Tget pp T1
| xH => PSome a
end
end.
Fixpoint Tadd (p:positive) (a:A) (T:Tree) {struct p}: Tree :=
match T with
| Tempty =>
match p with
| xI pp => Branch0 Tempty (Tadd pp a Tempty)
| xO pp => Branch0 (Tadd pp a Tempty) Tempty
| xH => Branch1 a Tempty Tempty
end
| Branch0 T1 T2 =>
match p with
| xI pp => Branch0 T1 (Tadd pp a T2)
| xO pp => Branch0 (Tadd pp a T1) T2
| xH => Branch1 a T1 T2
end
| Branch1 b T1 T2 =>
match p with
| xI pp => Branch1 b T1 (Tadd pp a T2)
| xO pp => Branch1 b (Tadd pp a T1) T2
| xH => Branch1 a T1 T2
end
end.
Definition mkBranch0 (T1 T2:Tree) :=
match T1,T2 with
Tempty ,Tempty => Tempty
| _,_ => Branch0 T1 T2
end.
Fixpoint Tremove (p:positive) (T:Tree) {struct p}: Tree :=
match T with
| Tempty => Tempty
| Branch0 T1 T2 =>
match p with
| xI pp => mkBranch0 T1 (Tremove pp T2)
| xO pp => mkBranch0 (Tremove pp T1) T2
| xH => T
end
| Branch1 b T1 T2 =>
match p with
| xI pp => Branch1 b T1 (Tremove pp T2)
| xO pp => Branch1 b (Tremove pp T1) T2
| xH => mkBranch0 T1 T2
end
end.
destruct p;reflexivity.
Qed.
Record Store : Type :=
mkStore  {index:positive;contents:Tree}.
Definition empty := mkStore xH Tempty.
Definition push a  S :=
mkStore (Pos.succ (index S)) (Tadd (index S) a (contents S)).
Definition get i S := Tget i (contents S).
intro i; case i; unfold empty,get; simpl;reflexivity.
Qed.
Inductive Full : Store -> Type:=
F_empty : Full empty
| F_push : forall a S, Full S -> Full (push a S).
intros [index0 contents0] F.
case F.
unfold empty,index,get,contents;intros;apply Tget_Tempty.
unfold push,index,get;simpl @contents.
intros a S.
rewrite Tget_Tadd.
rewrite Psucc_Gt.
intro W.
change (get (Pos.succ (index S)) S =PNone).
apply get_Full_Gt; auto.
apply Psucc_Gt.
Qed.

Lemma Full_push_compat : forall i a S, Full S ->
forall x, get i S = PSome x ->
get i (push a S) = PSome x.