(******************************************************************)
(*                                                                *)
(*        Implementation of contraction                           *)
(*                                                                *)
(******************************************************************)
Definition reorder (t1 t2 : tuple) :=
let (m1,m2,m3) := t1 in
let (n1,n2,n3) := t2 in
match tvcompare m1 n1 with
| Eq =>
match tvcompare m2 n2 with
| Eq => match tvcompare m3 n3 with
|Eq => None
| _ => Some (S1, S1, m1, m2, m3, n3)
end
| Lt =>
match tvcompare m3 n2 with
| Eq => Some (Sm1, S1, m1, m3, m2, n3)
| Lt => None
| Gt =>
match tvcompare m3 n3 with
| Eq => Some (Sm1, Sm1, m1, m3, m2, n2)
| _ => None
end
end
| Gt =>
match tvcompare m2 n3 with
| Eq => Some (S1, Sm1, m1, m2, m3, n2)
| Gt => None
| Lt =>
match tvcompare m3 n3 with
| Eq => Some (Sm1, Sm1, m1, m3, m2, n2)
| _ => None
end
end
end
| Lt =>
match tvcompare m2 n1 with
| Eq =>
match tvcompare m3 n2 with
| Eq => Some (S1, S1, m2, m3, m1, n3)
| Lt => None
| Gt =>
match tvcompare m3 n3 with
| Eq => Some (S1, Sm1, m2, m3, m1, n2)
| _ => None
end
end
| Lt => None
| Gt =>
match tvcompare m2 n2 with
| Eq =>
match tvcompare m3 n3 with
| Eq => Some (S1, S1, m2, m3, m1, n1)
| _ => None
end
| _ => None
end
end
| Gt =>
match tvcompare m1 n2 with
| Eq =>
match tvcompare m2 n3 with
| Eq => Some (S1, S1, m1, m2, m3, n1)
| Gt => None
| Lt =>
match tvcompare m3 n3 with
| Eq => Some (Sm1, S1, m1, m3, m2, n1)
| _ => None
end
end
| Gt => None
| Lt =>
match tvcompare m2 n2 with
| Eq =>
match tvcompare m3 n3 with
| Eq => Some (S1, S1, m2, m3, m1, n1)
| _ => None
end
| _ => None
end
end
end.

(* Specifications: *)
Lemma reorder_c t1 t2 :
match reorder t1 t2 with None => True | Some (s1, s2, m1,m2,m3,m4) =>
({t[t1]} =  s2k s1 * {t[Tuple m1 m2 m3]} /\
{t[t2]} =  s2k s2 * {t[Tuple m1 m2 m4]})%f
end.