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.

(* Specifications: *)
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.