Definition contraction_rule c t1 t2 t3 t4 :=
match reorder t1 t2 with
| None => None
| Some (s1, s2, m1, m2, m3, m4) =>
match reorder t3 t4 with
| None => None
| Some (s3, s4, n1, n2, n3, n4) =>
let s1 := smult s1 s3 in
let s2 := smult c (smult s2 s4) in
match smult s1 s2 with
| S0 => None | S1 => None
| Sm1 =>
match tvcompare m3 n4 with
| Lt => None | Gt => None
| Eq =>
match tvcompare m4 n3 with
| Lt => None | Gt => None
| Eq =>
match tvcompare m1 n1 with
| Eq => (*
(m1,m2,m3)(m1,n2,m4)
(m1,m2,m4)(m1,n2,m3)
*)
let (s3,t3) := tsort (Tuple m1 m2 n2) in
let (s4,t4) := tsort (Tuple m1 m3 m4) in
Some (smult s1 (smult s3 s4), t3, t4)
| Lt => match tvcompare m2 n1 with
| Eq =>
(* (m2,m1,m3)(m2,n2,m4) (m2,m1,m4)(m2,n2,m3) *)
let (s3,t3) := tsort (Tuple m1 m2 n2) in
let (s4,t4) := tsort (Tuple m2 m3 m4) in
Some (smult s1 (smult s3 s4), t3, t4)
| Lt => None
| Gt =>
match tvcompare m2 n2 with
| Eq =>
(* (m2,m1,m3)(m2,n1,m4) (m2,m1,m4)(m2,n1,m3) *)
let (s3,t3) := tsort (Tuple m2 m1 n1) in
let (s4,t4) := tsort (Tuple m2 m3 m4) in
Some (smult s1 (smult s3 s4), t3, t4)
| _ => None
end
end
| Gt => match tvcompare m1 n2 with
| Eq =>
(* (m1,m2,m3)(m1,n1,m4) (m1,m2,m4)(m1,n1,m3) *)
let (s3,t3) := tsort (Tuple m1 m2 n1) in
let (s4,t4) := tsort (Tuple m3 m1 m4) in
Some (smult s1 (smult s3 s4), t3, t4)
| Gt => None
| Lt =>
match tvcompare m2 n2 with
| Eq =>
(* (m2,m1,m3)(m2,n1,m4) (m2,m1,m4)(m2,n1,m3) *)
let (s3,t3) := tsort (Tuple m2 m1 n1) in
let (s4,t4) := tsort (Tuple m2 m3 m4) in
Some (smult s1 (smult s3 s4), t3, t4)
| _ => None
end
end
end end end end end end.

(* Specifications: *)
Lemma contraction_rule_c c t1 t2 t3 t4 :
match contraction_rule c t1 t2 t3 t4 with
| None => True
| Some (s, t5, t6) =>
({t[t1]} * {t[t3]} + s2k c * ({t[t2]} * {t[t4]}) =
s2k s * {t[t5]} * {t[t6]})%f
end.