Fixpoint eremove c l (e : expr) :=
  match e with
  | nil => None
  | (c1,l1) :: e1  =>
       if czerop (cadd c1 (copp c)) then
       match lcompare l l1 with
       | Eq => Some e1
       | _  => 
          match eremove c l e1 with
          | Some e2 => Some ((c1,l1):: e2)
          | _ => None
          end
       end
       else 
          match eremove c l e1 with
          | Some e2 => Some ((c1,l1):: e2)
          | _ => None
          end
  end.Definition do_contra (e : expr) :=
  match edelta e with
  | None  => Stop _ e
  | Some ((c1,l1),((c2,l2),(c3,l3)))  =>
     match eremove c2 l2 e with
     | Some e1 => 
       match eremove c1 l1 e1 with
       | Some e2 =>
           More _ (einsert c3 l3 e2)
       | _ => Stop _ e
       end
     | _ => Stop _ e
    end
  end.Definition iter_contra n e := iter_rp _ n do_contra (More _ e).Inductive action := 
  Inter (_ _ _ _ _: tvar) 
| SFree (_:tvar) (_:var) (_: tvar) (_:var) (_: tvar).Inductive action := 
  Inter (_ _ _ _ _: tvar) 
| SFree (_:tvar) (_:var) (_: tvar) (_:var) (_: tvar).Inductive action := 
  Inter (_ _ _ _ _: tvar) 
| SFree (_:tvar) (_:var) (_: tvar) (_:var) (_: tvar).Fixpoint interla (l : list action) (c : Prop) : Prop :=
  match l with
  | nil => c
  | a :: l1 => intera a -> interla l1 c
  end.Definition interla_refine (c1 c2 : Prop) l :
  (c1 -> c2) -> (interla l c1 -> interla l c2).Fixpoint resolve l e :=
  match l with
  | nil => e
  | (Inter x a b c d)::l1 =>
      rp_val _ (iter_elim 10 x a b c d (resolve l1 e))
  | (SFree x a b c d)::l1 =>
      rp_val _ (iter_free 10 x a b c d (resolve l1 e)) 
  end.Definition do_auto n l e :=
  let e1 := resolve l e in
  let e2 := rp_val _ (iter_contra 10 e1) in
  rp_val _ (iter_step n e2).Notation "'{' a ',' b ',' c '}'" := (Tuple _ a b c).(*  tvar -> nat *)
Definition tvar := nat.Definition tvcompare : tvar -> tvar -> comparison := natc.Definition tvarn : tvar -> nat := id.

(* Specifications: *)
Lemma tvcompare_inj v1 v2 : tvarn v1 = tvarn v2 -> v1 = v2.
Lemma tvcompare_def v1 v2 : tvcompare v1 v2 = natc (tvarn v1) (tvarn v2).