Section COMBINE.
Variable f: option L.t -> option L.t -> option L.t.
Hypothesis f_none_none: f None None = None.
Definition opt_eq (ox oy: option L.t) : Prop :=
match ox, oy with
| None, None => True
| Some x, Some y => L.eq x y
| _, _ => False
end.
Definition opt_beq (ox oy: option L.t) : bool :=
match ox, oy with
| None, None => true
| Some x, Some y => L.beq x y
| _, _ => false
end.
Definition tree_eq (m1 m2: PTree.t L.t) : Prop :=
forall i, opt_eq (PTree.get i m1) (PTree.get i m2).
Hint Resolve opt_beq_correct opt_eq_refl opt_eq_sym
tree_eq_refl tree_eq_sym
tree_eq_node tree_eq_node' tree_eq_node'' : combine.
Inductive changed: Type := Unchanged | Changed (m: PTree.t L.t).
Fixpoint combine_l (m : PTree.t L.t) {struct m} : changed :=
match m with
| PTree.Leaf =>
Unchanged
| PTree.Node l o r =>
let o' := f o None in
match combine_l l, combine_l r with
| Unchanged, Unchanged => if opt_beq o' o then Unchanged else Changed (PTree.Node' l o' r)
| Unchanged, Changed r' => Changed (PTree.Node' l o' r')
| Changed l', Unchanged => Changed (PTree.Node' l' o' r)
| Changed l', Changed r' => Changed (PTree.Node' l' o' r')
end
end.
Fixpoint combine_r (m : PTree.t L.t) {struct m} : changed :=
match m with
| PTree.Leaf =>
Unchanged
| PTree.Node l o r =>
let o' := f None o in
match combine_r l, combine_r r with
| Unchanged, Unchanged => if opt_beq o' o then Unchanged else Changed (PTree.Node' l o' r)
| Unchanged, Changed r' => Changed (PTree.Node' l o' r')
| Changed l', Unchanged => Changed (PTree.Node' l' o' r)
| Changed l', Changed r' => Changed (PTree.Node' l' o' r')
end
end.
Inductive changed2 : Type :=
| Same
| Same1
| Same2
| CC(m: PTree.t L.t).
Fixpoint xcombine (m1 m2 : PTree.t L.t) {struct m1} : changed2 :=
match m1, m2 with
| PTree.Leaf, PTree.Leaf =>
Same
| PTree.Leaf, _ =>
match combine_r m2 with
| Unchanged => Same2
| Changed m => CC m
end
| _, PTree.Leaf =>
match combine_l m1 with
| Unchanged => Same1
| Changed m => CC m
end
| PTree.Node l1 o1 r1, PTree.Node l2 o2 r2 =>
let o := f o1 o2 in
match xcombine l1 l2, xcombine r1 r2 with
| Same, Same =>
match opt_beq o o1, opt_beq o o2 with
| true, true => Same
| true, false => Same1
| false, true => Same2
| false, false => CC(PTree.Node' l1 o r1)
end
| Same1, Same | Same, Same1 | Same1, Same1 =>
if opt_beq o o1 then Same1 else CC(PTree.Node' l1 o r1)
| Same2, Same | Same, Same2 | Same2, Same2 =>
if opt_beq o o2 then Same2 else CC(PTree.Node' l2 o r2)
| Same1, Same2 => CC(PTree.Node' l1 o r2)
| (Same|Same1), CC r => CC(PTree.Node' l1 o r)
| Same2, Same1 => CC(PTree.Node' l2 o r1)
| Same2, CC r => CC(PTree.Node' l2 o r)
| CC l, (Same|Same1) => CC(PTree.Node' l o r1)
| CC l, Same2 => CC(PTree.Node' l o r2)
| CC l, CC r => CC(PTree.Node' l o r)
end
end.

Lemma xcombine_eq:
forall m1 m2,
match xcombine m1 m2 with
| Same => tree_eq m1 (PTree.combine f m1 m2) /\ tree_eq m2 (PTree.combine f m1 m2)
| Same1 => tree_eq m1 (PTree.combine f m1 m2)
| Same2 => tree_eq m2 (PTree.combine f m1 m2)
| CC m => tree_eq m (PTree.combine f m1 m2)
end.