(************************************************************************)
(*         *   The Coq Proof Assistant / The Coq Development Team       *)
(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
(* <O___,, *       (see CREDITS file for the list of authors)           *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)

(** Binary Integers : Parity and Division by Two *)
(** Initial author : Pierre Crégut (CNET, Lannion, France) *)

(** THIS FILE IS DEPRECATED.
    It is now almost entirely made of compatibility formulations
    for results already present in BinInt.Z. *)

Require Import BinInt.

Open Scope Z_scope.

(** Historical formulation of even and odd predicates, based on
    case analysis. We now rather recommend using [Z.Even] and
    [Z.Odd], which are based on the exist predicate. *)

Definition Zeven (z:Z) :=
  match z with
    | Z0 => True
    | Zpos (xO _) => True
    | Zneg (xO _) => True
    | _ => False
  end.

Definition Zodd (z:Z) :=
  match z with
    | Zpos xH => True
    | Zneg xH => True
    | Zpos (xI _) => True
    | Zneg (xI _) => True
    | _ => False
  end.

Lemma Zeven_equiv z : Zeven z <-> Z.Even z.
Proof.
 rewrite <- Z.even_spec.
 destruct z as [|p|p]; try destruct p; simpl; intuition.
Qed.

Lemma Zodd_equiv z : Zodd z <-> Z.Odd z.
Proof.
 rewrite <- Z.odd_spec.
 destruct z as [|p|p]; try destruct p; simpl; intuition.
Qed.

Theorem Zeven_ex_iff n : Zeven n <-> exists m, n = 2*m.
Proof (Zeven_equiv n).

Theorem Zodd_ex_iff n : Zodd n <-> exists m, n = 2*m + 1.
Proof (Zodd_equiv n).

(** Boolean tests of parity (now in BinInt.Z) *)

Notation Zeven_bool := Z.even (only parsing).
Notation Zodd_bool := Z.odd (only parsing).

Lemma Zeven_bool_iff n : Z.even n = true <-> Zeven n.
Proof.
 now rewrite Z.even_spec, Zeven_equiv.
Qed.

Lemma Zodd_bool_iff n : Z.odd n = true <-> Zodd n.
Proof.
 now rewrite Z.odd_spec, Zodd_equiv.
Qed.

Ltac boolify_even_odd := rewrite <- ?Zeven_bool_iff, <- ?Zodd_bool_iff.

Lemma Zodd_even_bool n : Z.odd n = negb (Z.even n).
Proof.
 symmetry. apply Z.negb_even.
Qed.

Lemma Zeven_odd_bool n : Z.even n = negb (Z.odd n).
Proof.
 symmetry. apply Z.negb_odd.
Qed.

Definition Zeven_odd_dec n : {Zeven n} + {Zodd n}.
Proof.
 destruct n as [|p|p]; try destruct p; simpl; (now left) || (now right).
Defined.

Definition Zeven_dec n : {Zeven n} + {~ Zeven n}.
Proof.
 destruct n as [|p|p]; try destruct p; simpl; (now left) || (now right).
Defined.

Definition Zodd_dec n : {Zodd n} + {~ Zodd n}.
Proof.
 destruct n as [|p|p]; try destruct p; simpl; (now left) || (now right).
Defined.

Lemma Zeven_not_Zodd n : Zeven n -> ~ Zodd n.
Proof.
 boolify_even_odd. rewrite <- Z.negb_odd. destruct Z.odd; intuition.
Qed.

Lemma Zodd_not_Zeven n : Zodd n -> ~ Zeven n.
Proof.
 boolify_even_odd. rewrite <- Z.negb_odd. destruct Z.odd; intuition.
Qed.

Lemma Zeven_Sn n : Zodd n -> Zeven (Z.succ n).
Proof.
 boolify_even_odd. now rewrite Z.even_succ.
Qed.

Lemma Zodd_Sn n : Zeven n -> Zodd (Z.succ n).
Proof.
 boolify_even_odd. now rewrite Z.odd_succ.
Qed.

Lemma Zeven_pred n : Zodd n -> Zeven (Z.pred n).
Proof.
 boolify_even_odd. now rewrite Z.even_pred.
Qed.

Lemma Zodd_pred n : Zeven n -> Zodd (Z.pred n).
Proof.
 boolify_even_odd. now rewrite Z.odd_pred.
Qed.

Hint Unfold Zeven Zodd: zarith.

Notation Zeven_bool_succ := Z.even_succ (only parsing).
Notation Zeven_bool_pred := Z.even_pred (only parsing).
Notation Zodd_bool_succ := Z.odd_succ (only parsing).
Notation Zodd_bool_pred := Z.odd_pred (only parsing).

(******************************************************************)
(** * Definition of [Z.quot2], [Z.div2] and properties wrt [Zeven]
  and [Zodd] *)

Notation Zdiv2 := Z.div2 (compat "8.6").
Notation Zquot2 := Z.quot2 (compat "8.6").

(** Properties of [Z.div2] *)

Lemma Zdiv2_odd_eqn n : n = 2*(Z.div2 n) + if Z.odd n then 1 else 0.
Proof (Z.div2_odd n).

Lemma Zeven_div2 n : Zeven n -> n = 2 * Z.div2 n.
Proof.
 boolify_even_odd. rewrite <- Z.negb_odd, Bool.negb_true_iff.
 intros Hn. rewrite (Zdiv2_odd_eqn n) at 1. now rewrite Hn, Z.add_0_r.
Qed.

Lemma Zodd_div2 n : Zodd n -> n = 2 * Z.div2 n + 1.
Proof.
 boolify_even_odd.
 intros Hn. rewrite (Zdiv2_odd_eqn n) at 1. now rewrite Hn.
Qed.

(** Properties of [Z.quot2] *)

(** TODO: move to Numbers someday *)

Lemma Zquot2_odd_eqn n : n = 2*(Z.quot2 n) + if Z.odd n then Z.sgn n else 0.
Proof.
 now destruct n as [ |[p|p| ]|[p|p| ]].
Qed.

Lemma Zeven_quot2 n : Zeven n -> n = 2 * Z.quot2 n.
Proof.
 intros Hn. apply Zeven_bool_iff in Hn.
 rewrite (Zquot2_odd_eqn n) at 1.
 now rewrite Zodd_even_bool, Hn, Z.add_0_r.
Qed.

Lemma Zodd_quot2 n : n >= 0 -> Zodd n -> n = 2 * Z.quot2 n + 1.
Proof.
 intros Hn Hn'. apply Zodd_bool_iff in Hn'.
 rewrite (Zquot2_odd_eqn n) at 1. rewrite Hn'. f_equal.
 destruct n; (now destruct Hn) || easy.
Qed.

Lemma Zodd_quot2_neg n : n <= 0 -> Zodd n -> n = 2 * Z.quot2 n - 1.
Proof.
 intros Hn Hn'. apply Zodd_bool_iff in Hn'.
 rewrite (Zquot2_odd_eqn n) at 1; rewrite Hn'. unfold Z.sub. f_equal.
 destruct n; (now destruct Hn) || easy.
Qed.

Lemma Zquot2_opp n : Z.quot2 (-n) = - Z.quot2 n.
Proof.
 now destruct n as [ |[p|p| ]|[p|p| ]].
Qed.

Lemma Zquot2_quot n : Z.quot2 n = n ÷ 2.
Proof.
 assert (AUX : forall m, 0 < m -> Z.quot2 m = m ÷ 2).
  {
   intros m Hm.
   apply Z.quot_unique with (if Z.odd m then Z.sgn m else 0).
   now apply Z.lt_le_incl.
   rewrite Z.sgn_pos by trivial.
   destruct (Z.odd m); now split.
   apply Zquot2_odd_eqn.
  }
 destruct (Z.lt_trichotomy 0 n) as [POS|[NUL|NEG]].
 - now apply AUX.
 - now subst.
 - apply Z.opp_inj. rewrite <- Z.quot_opp_l, <- Zquot2_opp.
   apply AUX. now destruct n. easy.
Qed.

(** More properties of parity *)

Lemma Z_modulo_2 n : {y | n = 2 * y} + {y | n = 2 * y + 1}.
Proof.
 destruct (Zeven_odd_dec n) as [Hn|Hn].
 - left. exists (Z.div2 n). exact (Zeven_div2 n Hn).
 - right. exists (Z.div2 n). exact (Zodd_div2 n Hn).
Qed.

Lemma Zsplit2 n :
 {p : Z * Z | let (x1, x2) := p in n = x1 + x2 /\ (x1 = x2 \/ x2 = x1 + 1)}.
Proof.
 destruct (Z_modulo_2 n) as [(y,Hy)|(y,Hy)];
  rewrite <- Z.add_diag in Hy.
 - exists (y, y). split. assumption. now left.
 - exists (y, y + 1). split. now rewrite Z.add_assoc. now right.
Qed.

Theorem Zeven_ex n : Zeven n -> exists m, n = 2 * m.
Proof.
 exists (Z.div2 n); apply Zeven_div2; auto.
Qed.

Theorem Zodd_ex n : Zodd n -> exists m, n = 2 * m + 1.
Proof.
 exists (Z.div2 n); apply Zodd_div2; auto.
Qed.

Theorem Zeven_2p p : Zeven (2 * p).
Proof.
 now destruct p.
Qed.

Theorem Zodd_2p_plus_1 p : Zodd (2 * p + 1).
Proof.
 destruct p as [|p|p]; now try destruct p.
Qed.

Theorem Zeven_plus_Zodd a b : Zeven a -> Zodd b -> Zodd (a + b).
Proof.
 boolify_even_odd. rewrite <- Z.negb_odd, Bool.negb_true_iff.
 intros Ha Hb. now rewrite Z.odd_add, Ha, Hb.
Qed.

Theorem Zeven_plus_Zeven a b : Zeven a -> Zeven b -> Zeven (a + b).
Proof.
 boolify_even_odd. intros Ha Hb. now rewrite Z.even_add, Ha, Hb.
Qed.

Theorem Zodd_plus_Zeven a b : Zodd a -> Zeven b -> Zodd (a + b).
Proof.
 intros. rewrite Z.add_comm. now apply Zeven_plus_Zodd.
Qed.

Theorem Zodd_plus_Zodd a b : Zodd a -> Zodd b -> Zeven (a + b).
Proof.
 boolify_even_odd. rewrite <- 2 Z.negb_even, 2 Bool.negb_true_iff.
 intros Ha Hb. now rewrite Z.even_add, Ha, Hb.
Qed.

Theorem Zeven_mult_Zeven_l a b : Zeven a -> Zeven (a * b).
Proof.
 boolify_even_odd. intros Ha. now rewrite Z.even_mul, Ha.
Qed.

Theorem Zeven_mult_Zeven_r a b : Zeven b -> Zeven (a * b).
Proof.
 intros. rewrite Z.mul_comm. now apply Zeven_mult_Zeven_l.
Qed.

Theorem Zodd_mult_Zodd a b : Zodd a -> Zodd b -> Zodd (a * b).
Proof.
 boolify_even_odd. intros Ha Hb. now rewrite Z.odd_mul, Ha, Hb.
Qed.

(* for compatibility *)
Close Scope Z_scope.


Require Export pdrvs.

Open Scope set_scope.

(** * Datatype of word-derivative certified pair
     We now define the datatype [ReW] witch is a pair of sets of [re], that
     also contains a word and a proof that the pair being considered corresponds
     to a word-partial derivative wrt. the original pair of regular expressions
     being tested for equivalence. *)

Section DataTypes.
  Variables r1 r2:re.

  (** First we define the notion of word partial derivative of pair of
       sets of regular expressions. *)

  Definition pdrvp(x:set re*set re)(a:Z) :=
    (pdrv_set (fst x) a,pdrv_set (snd x) a).

  Definition wpdrvp(x:set re * set re)(a:word) :=
    (wpdrv_set (fst x) a,wpdrv_set (snd x) a).

  Instance wpdrvp_m : Proper (_eq ==> _eq ==> _eq) wpdrvp.
  Proof.
    repeat red.
    intros.
    normalize_notations.
    split;intros.
    unfold _eq;simpl.
    normalize_notations.
    rewrite H0.
    destruct x.
    destruct y.
    simpl.
    inversion H.
    subst.
    rewrite H4.
    reflexivity.
    unfold _eq;simpl.
    normalize_notations.
    rewrite H0.
    destruct x.
    destruct y.
    simpl.
    inversion H.
    subst.
    rewrite H6.
    reflexivity.
  Qed.

  (** The type [ReW] is defined as a record with an inner coercion of [ReW] terms
       to pairs of sets, in order to allow an easier and less-verbose notion of
       equality and order, which corresponds to the already existing order of
       pairs of sets of regular expressions. *)

  Record ReW :=
    {
      dp :> set re * set re ;
      w  : word ;
      cw : dp === wpdrvp ({r1}%set,{r2}%set) w
    }.

    Global Transparent cw.

    Program Definition ReW_1st : ReW .
    Proof.
      refine(Build_ReW ({r1}%set,{r2}%set) nil _).
      unfold wpdrvp;simpl.
      constructor;unfold wpdrv_set;simpl;
        normalize_notations;auto.
    Defined.

    Corollary ReW_1st_dp_fst : fst (ReW_1st) = {r1}%set.
    Proof.
      simpl;reflexivity.
    Qed.

    Corollary ReW_1st_dp_snd : snd (ReW_1st) = {r2}%set.
    Proof.
      simpl;reflexivity.
    Qed.

    (** Now, we just provide the notions of equality and order, together with
       an instance of the [OrderedType] class, that ensures that elements of
       type [ReW] are ordered types. *)

    Definition ReW_eq(x y:ReW) :=
      _eq (A:=set re * set re) x y.

    Definition ReW_lt(x y:ReW) :=
      _lt (A:=set re * set re) x y.

    Global Program Instance ReW_ord : OrderedType ReW := {
      _eq := ReW_eq ;
      _lt := ReW_lt ;
      _cmp := _cmp (A:=set re * set re)
    }.
    Next Obligation.
      constructor.
      repeat red;order.
      repeat red;order.
      repeat red;order.
      unfold ReW_eq in H,H0;simpl in H,H0.
      normalize_notations;order.
    Defined.
    Next Obligation.
      constructor.
      unfold ReW_lt.
      repeat red;order.
      unfold ReW_lt;simpl;intros;intro.
      normalize_notations.
      apply lt_not_eq in H.
      contradiction.
    Defined.
    Next Obligation.
      case_eq(OrderedTypeEx.prod_compare x y);intros.
      constructor 2.
      unfold ReW_eq.
      normalize_notations.
      apply compare_2.
      assumption.
      constructor 1.
      apply compare_1;auto.
      constructor 3.
      apply compare_3;auto.
    Defined.

End DataTypes.

Typeclasses Opaque ReW_ord.

(** * Derivation of [ReW] terms.

     We now extend the notions of derivatives for terms of type [ReW], so that
     this type can be used in our decision procedure. The usage of these kind of
     terms facilitates the soundness proof for de decision procedures, which is
     based on the empty language property of the derivatives of the original
     regular expressions.
 *)
(*Generalizable All Variables.*)

Section ReW_Derivation.
  Variables r1 r2:re.

  (** Extension of partial derivatives wrt. a symbol of type [A] *)

  Definition ReW_pdrv (x:ReW r1 r2)(a:Z) : ReW r1 r2.
  Proof.
    refine(match x with
             | Build_ReW K w P =>
               Build_ReW r1 r2 (pdrvp K a) (w++[a])%list _
           end).
    abstract(unfold pdrvp;
    inversion_clear P;
    simpl in *;
    constructor;normalize_notations;simpl;
    [rewrite H|rewrite H0];
    rewrite wpdrv_set_app;unfold wpdrv_set;simpl;reflexivity).
  Defined.

  (** Build a particular derivative of [r1] and [r2], directly from a given word. *)

  Definition ReW_wpdrv (w:word) : ReW r1 r2.
  Proof.
    refine(Build_ReW r1 r2 (wpdrvp (singleton r1, singleton r2) w) w _).
    abstract(reflexivity).
  Defined.

  Global Instance ReW_pdrv_m : Proper(_eq ==> _eq ==> _eq) ReW_pdrv.
  Proof.
    repeat red;intros.
    destruct x.
    destruct y.
    inversion H.
    normalize_notations.
    simpl.
    simpl in H3,H4.
    rewrite <- H3,<- H4.
    rewrite H0.
    clear cw0 H3 cw1 H4 H.
    unfold pdrvp.
    simpl.
    constructor;
      [rewrite H1|rewrite H2];reflexivity.
  Qed.

  (** Generalization to sets *)
  Definition ReW_wpdrv_ReW (w:word)(s:ReW r1 r2) : ReW r1 r2.
  Proof.
    destruct s.
    destruct dp0;simpl in *.
    refine(Build_ReW r1 r2 (wpdrvp (s,s0) w) (w0++w)%list _).
    abstract(unfold wpdrvp;
             simpl;
             inversion cw0;
             normalize_notations;
             constructor;[
               rewrite wpdrv_set_app;
               rewrite <- H2;
               reflexivity |
               rewrite wpdrv_set_app;
                 rewrite <- H4;
                 reflexivity]).
  Defined.

  Instance ReW_wpdrv_ReW_m_same_w :
    forall w,
      Proper (_eq ==> _eq) (fun x => ReW_wpdrv_ReW w x).
  Proof.
    repeat red.
    intros.
    destruct x.
    destruct y.
    inversion H.
    simpl in H2,H3.
    Opaque ReW_wpdrv_ReW.
    simpl.
    normalize_notations.
    Transparent ReW_wpdrv_ReW.
    destruct dp0.
    destruct dp1.
    simpl.
    rewrite <- H2,<- H3.
    unfold wpdrvp.
    simpl.
    constructor;[rewrite H0|rewrite H1];reflexivity.
  Qed.

  Instance ReW_wpdrv_ReW_m : Proper (_eq ==> _eq ==> _eq) ReW_wpdrv_ReW.
  Proof.
    repeat red;intros.
    destruct x0.
    destruct y0.
    inversion H0.
    simpl in H3,H4.
    Opaque ReW_wpdrv_ReW.
    simpl.
    normalize_notations.
    destruct dp0;destruct dp1.
    Transparent ReW_wpdrv_ReW.
    simpl.
    rewrite <- H3,<- H4.
    constructor;simpl;normalize_notations;
    [rewrite H1 | rewrite H2];rewrite H;reflexivity.
  Qed.

  Lemma ReW_wpdrv_step :
    forall w a,
      ReW_wpdrv ((@>w)++[a])%list === ReW_pdrv (ReW_wpdrv (@>w)) a.
  Proof.
    induction w0.
    intro.
    change(@>(inil)) with (@nil Z).
    change ((@nil Z)++[a])%list with [a].
    assert((ReW_wpdrv []) === ReW_1st r1 r2).
    vm_compute;split;auto.
    rewrite H.
    unfold ReW_wpdrv , ReW_pdrv.
    simpl.
    unfold wpdrvp, pdrvp.
    simpl.
    constructor;reflexivity.
    intro.
    unfold ReW_wpdrv, ReW_pdrv.
    constructor.
    simpl.
    normalize_notations.
    rewrite wpdrv_set_app.
    unfold wpdrv_set.
    simpl.
    reflexivity.
    simpl.
    normalize_notations.
    rewrite wpdrv_set_app.
    unfold wpdrv_set.
    simpl.
    reflexivity.
  Qed.

  (** Extension of derivation of [ReW] terms to finite sets *)

  Definition ReW_pdrv_set(s:ReW r1 r2)(Sig:set Z) : set (ReW r1 r2) :=
    fold (fun x:Z => add (ReW_pdrv s x)) Sig {}%set.

  Definition ReW_wpdrv_set(s:set (ReW r1 r2))(w:word) : set (ReW r1 r2) :=
    fold (fun x => add (ReW_wpdrv_ReW w x)) s {}%set.

  Instance add_ReW_pdrv : forall x0, Proper (_eq ==> _eq ==> _eq)
                                 (fun x1 : Z => add (ReW_pdrv x0 x1)).
  Proof.
    repeat red;intros.
    split;intros.
    apply add_iff in H1;destruct H1.
    rewrite <- H1.
    apply add_1.
    apply ReW_pdrv_m;auto.
    apply add_2;auto.
    apply H0;auto.
    apply add_iff in H1;destruct H1.
    rewrite <- H1.
    apply add_1.
    apply ReW_pdrv_m;auto.
    apply add_2.
    apply H0;auto.
  Qed.

  Instance add_ReW_wpdr : forall x0, Proper (_eq ==> _eq ==> _eq)
                                 (fun x : word => add (ReW_wpdrv_ReW x x0)).
  Proof.
    repeat red;intros.
    split;intros.
    apply add_iff in H1;destruct H1.
    rewrite <- H1.
    apply add_1.
    rewrite H.
    reflexivity.
    apply add_2.
    rewrite <- H0;assumption.
    apply add_iff in H1.
    destruct H1.
    rewrite <- H in H1.
    rewrite H1.
    apply add_1;auto.
    rewrite <- H0 in H1.
    apply add_2;auto.
  Qed.

  Lemma add_ReW_pdrv_transp : forall x0,
                                transpose _eq (fun x1 : Z => add (ReW_pdrv x0 x1)).
  Proof.
    repeat red;intros.
    split;intros;
    apply add_iff in H;
    destruct H.
    rewrite <- H.
    apply add_2;apply add_1;auto.
    apply add_iff in H;destruct H.
    rewrite H.
    apply add_1;auto.
    do 2 apply add_2;auto.
    intuition.
    apply add_iff in H;destruct H.
    apply add_1;auto.
    do 2 apply add_2;auto.
  Qed.

  Lemma ReW_pdrv_set_elem_in : forall sig s a,
                                 a \In sig -> ReW_pdrv s a \In ReW_pdrv_set s sig.
  Proof.
    induction sig using set_induction.
    intros s a H1.
    apply H in H1.
    elim H1.
    intros.
    apply H0 in H1.
    destruct H1.
    unfold ReW_pdrv_set.
    rewrite (@fold_2 Z _ _ _ sig1 sig2 x (set (ReW r1 r2)) _eq OT_Equivalence
                     (empty (A:=ReW r1 r2)) (fun x0 : Z => add (ReW_pdrv s x0))
                     _ (add_ReW_pdrv_transp s) H H0).
    apply add_1.
    apply ReW_pdrv_m;auto.
    eapply IHsig1 with s a in H1.
    unfold ReW_pdrv_set.
    rewrite (@fold_2 Z _ _ _ sig1 sig2 x (set (ReW r1 r2)) _eq OT_Equivalence
                     (empty (A:=ReW r1 r2)) (fun x0 : Z => add (ReW_pdrv s x0))
                     _ (add_ReW_pdrv_transp s) H H0).
    apply add_2.
    apply H1.
  Qed.

  Lemma A_leibniz : forall x y:Z, x === y -> x = y.
  Proof.
    induction 1.
    reflexivity.
  Qed.

  Global Instance ReW_pdrv_set_aux_m : Proper(eq ==> _eq ==> _eq)
                                             (fun x a => ReW_pdrv_set x a).
  Proof.
    repeat red;intros.
    rewrite H.
    clear H x.
    revert x0 y0 H0 a.
    induction x0 using set_induction.
    intros y0 H1.
    unfold ReW_pdrv_set.
    rewrite fold_1b;auto.
    rewrite H1 in H.
    rewrite fold_1b;auto.
    intros.
    unfold ReW_pdrv_set.
    generalize (@fold_2 Z _ _ _ x0_1 x0_2 x (set (ReW r1 r2)) _eq OT_Equivalence {}%set
                (fun x0 : Z => add (ReW_pdrv y x0)) (add_ReW_pdrv _) (add_ReW_pdrv_transp y) H H0).
    intro.
    split;intros.
    apply H2 in H3.
    cut(SetProperties.Add x x0_1 y0).
    intro.
    generalize (@fold_2 Z _ _ _ x0_1 y0 x (set (ReW r1 r2)) _eq OT_Equivalence {}%set
               (fun x1 : Z => add (ReW_pdrv y x1)) (add_ReW_pdrv _) (add_ReW_pdrv_transp y) H H4).
    intro.
    apply H5.
    apply add_iff in H3;destruct H3.
    apply add_1;auto.
    apply add_2;auto.
    apply Add_Equal in H0.
    apply Add_Equal.
    rewrite <- H0;auto.
    rewrite H1.
    reflexivity.
    cut(SetProperties.Add x x0_1 y0).
    intro.
    apply H2.
    generalize (@fold_2 Z _ _ _ x0_1 y0 x (set (ReW r1 r2)) _eq OT_Equivalence {}%set
                   (fun x1 : Z => add (ReW_pdrv y x1)) (add_ReW_pdrv _) (add_ReW_pdrv_transp y) H H4).
    intro.
    apply H5 in H3.
    apply add_iff in H3;destruct H3.
    apply add_1;auto.
    apply add_2.
    assumption.
    apply Add_Equal in H0.
    apply Add_Equal.
    rewrite <- H0;auto.
    rewrite H1;auto.
    reflexivity.
  Qed.

  Global Instance ReW_pdrv_set_aux_2_m : Proper(_eq ==> eq ==> _eq)
                                               (fun x a => ReW_pdrv_set x a).
  Proof.
    repeat red;intros.
    rewrite H0.
    clear H0 x0.
    revert y0 a.
    induction y0 using set_induction.
    unfold ReW_pdrv_set.
    rewrite fold_1b;auto.
    rewrite fold_1b;auto.
    intro.
    unfold ReW_pdrv_set.
    generalize (@fold_2 Z _ _ _ y0_1 y0_2 x0 (set (ReW r1 r2)) _eq OT_Equivalence
                        {}%set
                        (fun x1 : Z => add (ReW_pdrv x x1)) (add_ReW_pdrv _) (add_ReW_pdrv_transp x) H0 H1).
    intro.
    generalize (@fold_2 Z _ _ _ y0_1 y0_2 x0 (set (ReW r1 r2)) _eq OT_Equivalence
                        {}%set
                        (fun x1 : Z => add (ReW_pdrv y x1)) (add_ReW_pdrv _) (add_ReW_pdrv_transp y) H0 H1).
    intro.
    split;intros.
    apply H3.
    apply H2 in H4.
    apply add_iff in H4;destruct H4.
    apply add_1.
    rewrite <- H4.
    eapply ReW_pdrv_m;auto.
    specialize IHy0_1 with a.
    destruct IHy0_1.
    apply add_2.
    apply H5.
    assumption.
    apply H2.
    apply H3 in H4.
    apply add_iff in H4;destruct H4.
    apply add_1.
    rewrite <- H4.
    apply ReW_pdrv_m;auto.
    apply add_2.
    specialize IHy0_1 with a.
    destruct IHy0_1.
    apply H6;auto.
  Qed.

  Global Instance ReW_pdrv_set_m : Proper(_eq ==> _eq ==> _eq)
                                         (fun x a => ReW_pdrv_set x a).
  Proof.
    repeat red.
    intros.
    revert x0 y0 H0.
    induction x0 using set_induction.
    unfold ReW_pdrv_set.
    intros y0 H1.
    rewrite fold_1b;auto.
    rewrite H1 in H0.
    rewrite fold_1b;auto.
    intros y0 H2.
    split;intros.
    unfold ReW_pdrv_set in H3 |- *.
    generalize (@fold_2 Z _ _ _ x0_1 x0_2 x0 (set (ReW r1 r2)) _eq OT_Equivalence
                        {}%set
                        (fun x0 : Z => add (ReW_pdrv x x0)) (add_ReW_pdrv _) (add_ReW_pdrv_transp x) H0 H1);
      intros.
    cut(SetProperties.Add x0 x0_1 y0).
    intro.
    generalize (@fold_2 Z _ _ _ x0_1 y0 x0 (set (ReW r1 r2)) _eq OT_Equivalence
                        {}%set
                        (fun x1 : Z => add (ReW_pdrv y x1)) (add_ReW_pdrv _) (add_ReW_pdrv_transp y) H0 H5);
      intros.
    apply H6.
    apply H4 in H3.
    apply add_iff in H3.
    destruct H3.
    apply add_1.
    rewrite <- H3.
    apply ReW_pdrv_m;auto.
    clear H4 H6.
    apply add_2.
    revert H3.
    apply ReW_pdrv_set_aux_2_m;auto.
    apply Add_Equal in H1.
    apply Add_Equal.
    rewrite <- H1.
    rewrite H2.
    reflexivity.
    unfold ReW_pdrv_set in H3 |- *.
    generalize (@fold_2 Z _ _ _ x0_1 x0_2 x0 (set (ReW r1 r2)) _eq OT_Equivalence
                        {}%set
                        (fun x0 : Z => add (ReW_pdrv x x0)) (add_ReW_pdrv _) (add_ReW_pdrv_transp x) H0 H1);
      intros.
    cut(SetProperties.Add x0 x0_1 y0).
    intro.
    generalize (@fold_2 Z _ _ _ x0_1 y0 x0 (set (ReW r1 r2)) _eq OT_Equivalence
                        {}%set
                        (fun x1 : Z => add (ReW_pdrv y x1)) (add_ReW_pdrv _) (add_ReW_pdrv_transp y) H0 H5);
      intros.
    apply H4.
    apply H6 in H3.
    apply add_iff in H3.
    destruct H3.
    apply add_1.
    rewrite <- H3.
    apply ReW_pdrv_m;auto.
    clear H4 H6.
    apply add_2.
    revert H3.
    apply ReW_pdrv_set_aux_2_m;auto.
    apply Add_Equal in H1.
    apply Add_Equal.
    rewrite <- H1.
    rewrite H2.
    reflexivity.
  Qed.

End ReW_Derivation.

Notation "x %d[ y  ]" :=
  (ReW_pdrv _ _ x y)
    (at level 45, y at next level).

Notation "x %dS[ y  ]" :=
  (ReW_pdrv_set _ _ x y)
    (at level 45, y at next level).

(** * Filtering the new pairs of derivatives

     Not all new derivatives are considered for further processing. If a new pair [x]
     already exists in the historic set [h], then it is discarded (this happens every time is appears along the execution of the main procedure. The only role that this function, named [ReW_pdrv_set_filtered] plays is to avoid cyclic behavior of the procedure. *)

Section ReW_Derivation_filtered.
  Variables r1 r2:re.

  Definition ReW_pdrv_set_filtered(x:ReW r1 r2)(h:set (ReW r1 r2))
             (sig:set Z) : set (ReW r1 r2) :=
    filter (fun x => negb (mem x h)) (x %dS[sig]).

  Instance ReW_negb_m :
   forall y0, Proper (_eq ==> eq) (fun x2 : ReW r1 r2 => negb (x2 \in y0)).
  Proof.
    repeat red;intros.
    rewrite H.
    reflexivity.
  Qed.

  Global Instance ReW_pdrv_set_filtered_m :
    Proper(_eq ==> _eq ==> _eq ==> _eq) ReW_pdrv_set_filtered.
  Proof.
    repeat red;intros.
    split;intros.
    unfold ReW_pdrv_set_filtered in *.
    apply filter_iff in H2;auto with typeclass_instances.
    apply filter_iff;auto with typeclass_instances.
    rewrite <- H.
    rewrite <- H1.
    rewrite H0 in H2.
    assumption.
    unfold ReW_pdrv_set_filtered in *.
    apply filter_iff in H2;auto with typeclass_instances.
    apply filter_iff;auto with typeclass_instances.
    rewrite H.
    rewrite H1.
    rewrite <- H0 in H2.
    assumption.
  Qed.

  (** Exclusion of elements already present in the historic set [h] *)
  Lemma ReW_pdrv_set_filtered_no_dup : forall x h sig y,
                                         y \In ReW_pdrv_set_filtered x h sig ->
                                         ~y \In h.
  Proof.
    intros.
    unfold ReW_pdrv_set_filtered in H.
    apply filter_iff in H;auto with typeclass_instances.
    destruct H.
    intro.
    apply mem_iff in H1.
    apply Bool.negb_true_iff in H0.
    rewrite H0 in H1;discriminate.
  Qed.

  Global Instance ReW_pdrv_add_m :
    forall r:ReW r1 r2,
      Proper (_eq ==> _eq ==> _eq) (fun x0 : Z => add (r %d[ x0 ])).
  Proof.
    repeat red.
    split;intros.
    rewrite H,H0 in H1.
    assumption.
    rewrite H,H0;assumption.
  Qed.

  Fact ReW_pdrv_add_transpose :
    forall r:ReW r1 r2,
      transpose Equal (fun x0 : Z => add (r %d[ x0 ])).
  Proof.
    repeat red.
    split;intros.
    apply add_iff in H.
    destruct H.
    rewrite H.
    apply add_2;apply add_1;auto.
    apply add_iff in H.
    destruct H;
      [rewrite H;apply add_1 | apply add_2;apply add_2];auto.
    apply add_iff in H.
    destruct H.
    rewrite H;apply add_2;apply add_1;auto.
    apply add_iff in H;destruct H.
    rewrite H;apply add_1;auto.
    apply add_2;apply add_2;auto.
  Qed.

  Hint Resolve ReW_pdrv_add_transpose : typeclass_instances.

  Lemma ReW_in_pdrv_set :
    forall sig (r:ReW r1 r2) a, a \In sig ->
                                (ReW_pdrv _ _ r a) \In (ReW_pdrv_set _ _ r sig).
  Proof.
    intro sig.
    induction sig using set_induction.
    intros.
    generalize(H a).
    intro.
    contradiction.
    intros.
    eapply ReW_pdrv_set_m.
    reflexivity.
    reflexivity.
    apply Add_Equal in H0.
    rewrite H0.
    unfold ReW_pdrv_set.
    rewrite H0 in H1.
    apply add_iff in H1.
    destruct H1.
    rewrite fold_add;auto with typeclass_instances.
    apply add_1.
    rewrite H1.
    reflexivity.
    rewrite fold_add;auto with typeclass_instances.
    apply add_2.
    apply IHsig1;assumption.
  Qed.

  Lemma ReW_pdrv_set_filtered_ex :
    forall x h sig y,
      y \In ReW_pdrv_set_filtered x h sig ->
      exists a, a \In sig /\ y === ReW_pdrv r1 r2 x a.
  Proof.
    intros.
    unfold ReW_pdrv_set_filtered in H.
    apply filter_iff in H;auto with typeclass_instances.
    destruct H.
    revert sig y H H0.
    induction sig using set_induction.
    intros.
    unfold ReW_pdrv_set in H0.
    rewrite fold_1b in H0;auto with typeclass_instances.
    inversion H0.
    intro y.
    unfold ReW_pdrv_set.
    intros.
    generalize (@fold_2 Z _ _ _ sig1 sig2 x0 (set (ReW r1 r2)) _eq OT_Equivalence
                        {}%set
                        (fun x1 : Z => add (ReW_pdrv r1 r2 x x1)) (ReW_pdrv_add_m x)
                        (add_ReW_pdrv_transp r1 r2 x) H H0);intro.
    rewrite H3 in H1.
    apply add_iff in H1.
    destruct H1.
    exists x0.
    split.
    apply H0;auto.
    rewrite H1;reflexivity.
    apply IHsig1 in H1;auto.
    destruct H1  as [a [h4 H5]].
    exists a.
    split.
    apply H0;auto.
    assumption.
  Qed.

End ReW_Derivation_filtered.

Notation "x %dF[ h , y  ]" :=
  (ReW_pdrv_set_filtered _ _ x h y)
    (at level 45, h at next level, y at next level).

  (** * Empty language property for [ReW]

     We now extend the notion of the syntactical property of the empty language
     for terms of type [ReW]. This notion if fulcral for finding and exhibiting
     counter-examples of the equivalence of regular expressions.
     *)

Section ReW_Emptyness.
  Variables r1 r2:re.

  Definition c_of_rep(x:set re  * set re) :=
    Bool.eqb (c_of_re_set (fst x)) (c_of_re_set (snd x)).

  Global Instance c_of_rep_m : Proper(_eq ==> _eq) c_of_rep.
  Proof.
    repeat red.
    intros.
    destruct x;destruct y;normalize_notations.
    unfold c_of_rep;simpl in *.
    inversion_clear H.
    rewrite H0.
    rewrite H1.
    reflexivity.
  Qed.

  Definition c_of_ReW(x:ReW r1 r2) :=
    c_of_rep x.

  Global Instance c_of_ReW_m : Proper(_eq ==> _eq) c_of_ReW.
  Proof.
    repeat red;intros.
    unfold c_of_ReW.
    apply c_of_rep_m.
    assumption.
  Qed.

  Definition c_of_ReW_set (x:set (ReW r1 r2)) : bool :=
    fold (fun x => andb (c_of_ReW x)) x true.

  Global Instance andb_c_of_ReW_m :
    Proper (_eq ==> _eq ==> _eq) (fun x : ReW r1 r2 => andb (c_of_ReW x)).
  Proof.
    repeat red.
    intros.
    rewrite H0.
    apply (c_of_ReW_m) in H.
    rewrite H.
    reflexivity.
  Qed.

  Lemma andb_c_of_ReW_m_transpose :
    transpose _eq (fun x : ReW r1 r2 => andb (c_of_ReW x)).
  Proof.
    repeat red;intros.
    destruct(c_of_ReW x).
    simpl;auto.
    simpl.
    rewrite Bool.andb_false_r.
    reflexivity.
  Qed.

  Global Instance c_of_ReW_set_m : Proper(_eq ==> _eq) c_of_ReW_set.
  Proof.
    repeat red.
    induction x using set_induction;intros.
    unfold c_of_ReW_set.
    rewrite fold_1b;auto.
    rewrite H0 in H.
    rewrite fold_1b;auto.
    assert(SetProperties.Add x3 x1 y).
    apply Add_Equal in H0.
    apply Add_Equal.
    rewrite <- H0;symmetry;auto.
    unfold c_of_ReW_set.
    generalize (@fold_2 (ReW r1 r2) _ _ _ x1 x2 x3 (bool) _eq OT_Equivalence true
                        (fun x : ReW r1 r2 => andb (c_of_ReW x)) _ (andb_c_of_ReW_m_transpose) H H0);
      intro.
    rewrite H3.
    generalize (@fold_2 (ReW r1 r2) _ _ _ x1 y x3 (bool) _eq OT_Equivalence true
                        (fun x : ReW r1 r2 => andb (c_of_ReW x)) _ (andb_c_of_ReW_m_transpose) H H2);
      intro.
    rewrite H4.
    reflexivity.
  Qed.

  Lemma wit_in_c_of_ReW_set : forall s,
                                c_of_ReW_set s = false -> exists x, x \In s /\
                                                                    c_of_ReW x = false.
  Proof.
    induction s using set_induction.
    intro.
    apply empty_is_empty_1 in H.
    rewrite H in H0.
    unfold c_of_ReW_set in H0.
    vm_compute in H0.
    discriminate.
    intro.
    unfold c_of_ReW_set in H1.
    generalize (@fold_2 (ReW r1 r2) _ _ _ s1 s2 x (bool) _eq OT_Equivalence true
                        (fun x : ReW r1 r2 => andb (c_of_ReW x)) _ (andb_c_of_ReW_m_transpose) H H0).
    intro.
    rewrite H2 in H1;clear H2.
    case_eq(c_of_ReW x).
    intro.
    rewrite H2 in H1.
    simpl in H1.
    apply IHs1 in H1.
    destruct H1.
    destruct H1.
    exists x0.
    split;auto.
    apply H0;auto.
    intro.
    exists x.
    split;auto.
    apply H0;auto.
  Qed.

  Lemma wit_all_in_c_of_ReW_set : forall s,
                                    c_of_ReW_set s = true -> forall x, x \In s ->
                                                                       c_of_ReW x = true.
  Proof.
    induction s using set_induction.
    intros.
    apply H in H1;elim H1.
    intros.
    generalize (@fold_2 (ReW r1 r2) _ _ _ s1 s2 x (bool) _eq OT_Equivalence true
                        (fun x : ReW r1 r2 => andb (c_of_ReW x)) _ (andb_c_of_ReW_m_transpose) H H0).
    intro.
    apply H0 in H2.
    unfold c_of_ReW_set in H1;rewrite H3 in H1.
    destruct H2.
    rewrite <- H2.
    case_eq(c_of_ReW x);intros;auto.
    rewrite H4 in H1;simpl in H1;discriminate.
    case_eq(c_of_ReW x);intros;auto.
    rewrite H4 in H1;simpl in H1.
    generalize(IHs1 H1 _ H2);auto.
    rewrite H4 in H1;discriminate.
  Qed.

  (** *Acrescentar propriedades das constantes para os conjuntos *)

  Lemma c_of_ReW_nequiv : forall x, c_of_ReW x = false ->
                                    c_of_rep x = false.
  Proof.
    intros.
    unfold c_of_ReW in H.
    assumption.
  Qed.

  Lemma c_of_ReW_wpdrv : forall x b,
                           c_of_ReW x = b -> exists w, c_of_rep(wpdrvp ({r1}%set,{r2}%set) w) = b.
  Proof.
    intros.
    destruct x.
    exists w0.
    unfold c_of_ReW in H.
    simpl in H.
    rewrite <- cw0.
    assumption.
  Qed.

  Lemma c_of_rep_diff_constant : forall x y w,
                                   c_of_rep(wpdrvp (x,y) w) = false ->
                                   c_of_re_set(wpdrv_set x w) <> c_of_re_set(wpdrv_set y w).
  Proof.
    intros.
    unfold c_of_rep in H.
    intro.
    simpl in H.
    apply Bool.eqb_false_iff in H.
    contradiction.
  Qed.

  Lemma c_of_ReW_diff_wpdrvs_orig : forall x,
                                      c_of_ReW x = false -> exists w,
                                                              c_of_re_set(wpdrv r1 w) <> c_of_re_set(wpdrv r2 w).
  Proof.
    intros.
    apply c_of_ReW_wpdrv in H.
    destruct H.
    apply c_of_rep_diff_constant in H.
    exists x0.
    do 2 rewrite wpdrv_set_singleton in H.
    assumption.
  Qed.

  (** Lemma that proves the inequivalence of regular expressions *)

  Lemma c_of_ReW_diff_wpdrvs_Srels : forall x,
                                       c_of_ReW x = false -> r1 !∼ r2.
  Proof.
    intros.
    apply c_of_ReW_diff_wpdrvs_orig in H.
    destruct H.
    case_eq(εs(∂w(r1,x0)));intros.
    case_eq(εs(∂w(r2,x0)));intros.
    rewrite H0,H1 in H;elim H;auto.
    apply c_of_re_set_has_nil in H0.
    apply c_of_re_set_has_not_nil in H1.
    intro.
    apply wpdrv_correct in H0.
    apply H1.
    apply wpdrv_correct.
    inversion_clear H0.
    constructor.
    apply H2 in H3.
    assumption.
    case_eq(εs(∂w(r2,x0)));intros.
    intro.
    apply c_of_re_set_has_nil in H1.
    apply c_of_re_set_has_not_nil in H0.
    apply H0.
    apply wpdrv_correct in H1.
    apply wpdrv_correct.
    inversion_clear H1.
    constructor.
    apply H2 in H3.
    assumption.
    rewrite H0,H1 in H;elim H;auto.
  Qed.

  Lemma false_in_c_of_ReW_set : forall x s,
                                  c_of_ReW x = false -> x \In s -> c_of_ReW_set s = false.
  Proof.
    intros x s.
    revert s x.
    induction s using set_induction.
    intros.
    apply H in H1;inversion H1.
    intros.
    generalize (@fold_2 (ReW r1 r2) _ _ _ s1 s2 x (bool) _eq OT_Equivalence true
                        (fun x : ReW r1 r2 => andb (c_of_ReW x)) _ (andb_c_of_ReW_m_transpose) H H0).
    apply H0 in H2.
    destruct H2.
    intro.
    unfold c_of_ReW_set.
    rewrite H3.
    rewrite H2.
    rewrite H1.
    simpl.
    reflexivity.
    intro.
    rewrite H3.
    generalize(IHs1 _ H1 H2);intro.
    unfold c_of_ReW_set in H4.
    rewrite H4.
    rewrite Bool.andb_comm.
    simpl.
    reflexivity.
  Qed.

End ReW_Emptyness.

Notation "%e_p x"  := (c_of_rep x)(at level 30).
Notation "%e_rew c " := (c_of_ReW _ _ c)(at level 30).

Section DerivativesGenerator.
  Variables r1 r2:re.

  Definition _cmpRP := _cmp (A:=set re).

  Inductive DisjPP (h s:set (ReW r1 r2)) : Prop :=
  | disjPP : inter h s === {}%set -> DisjPP h s.

  Inductive DP (h s:set (ReW r1 r2)) : Prop :=
  | is_dpt : inter h s === {} -> (*DisjPP h s -> *)
             c_of_ReW_set _ _ h = true -> DP h s.

  Inductive StepFastCase' : Type :=
  |Process' : StepFastCase'
  |TermTrue' : set (ReW r1 r2) -> StepFastCase'
  |TermFalse' : ReW r1 r2 -> StepFastCase'.

  Generate OrderedType StepFastCase'.

  Definition StepFast' (h s:set (ReW r1 r2))(sig:set Z) :
    (set (ReW r1 r2) * set (ReW r1 r2)) * StepFastCase' :=
    match choose s with
      | None => ((h,s),TermTrue' h)
      | Some x =>
        if c_of_ReW _ _ x then
          let h' := add x h in
          let s' := remove x s in
          let ns :=  ReW_pdrv_set_filtered _ _ x h' sig in
          ((h',union ns s'),Process')
        else
          ((h,s),TermFalse' x)
    end.

End DerivativesGenerator.

Require Export wf_extra.

Section Cardinality_Properties.
  Variables r1 r2 : re.

  Lemma ReW_in_PD_fst : forall (x:ReW r1 r2) (s:set (ReW r1 r2)),
                          x \In s -> cardinal (fst x) <= cardinal (PD r1).
  Proof.
    intros.
    destruct x.
    simpl.
    destruct dp0.
    simpl in *.
    unfold wpdrvp in cw0.
    simpl in cw0.
    inversion_clear cw0.
    normalize_notations.
    rewrite H0.
    apply subset_cardinal.
    rewrite wpdrv_set_singleton.
    red;intros.
    eapply all_wpdrv_in_PD with (<@w0).
    assumption.
  Qed.

  Lemma ReW_in_PD_snd : forall x (s:set (ReW r1 r2)),
                          x \In s -> cardinal (snd x) <= cardinal (PD r2).
  Proof.
    intros.
    destruct x.
    simpl.
    destruct dp0.
    simpl in *.
    unfold wpdrvp in cw0.
    simpl in cw0.
    inversion_clear cw0.
    normalize_notations.
    rewrite H1.
    apply subset_cardinal.
    rewrite wpdrv_set_singleton.
    red;intros.
    eapply all_wpdrv_in_PD with (<@w0).
    assumption.
  Qed.

  Definition ReW_to_set_re (s:set (ReW r1 r2)) : set (set re * set re) :=
    fold (fun x => add (@dp r1 r2 x)) s  {}%set.

  Instance add_dp_m : Proper (_eq ==> _eq ==> _eq)
                             (fun x : ReW r1 r2 => add (@dp r1 r2 x)).
  Proof.
    Opaque _eq.
    repeat red;intros.
    change (_eq x y) with (prod_eq (Equal_pw (set re) re SetInterface.In)
        (Equal_pw (set re) re SetInterface.In) x y) in H.
    Transparent _eq.
    split;intros;normalize_notations.
    abstract(apply add_iff in H1;destruct H1;
    [apply add_1;rewrite <- H;assumption|apply add_2;apply H0 ; auto]).
    abstract(apply add_iff in H1;destruct H1;
             [apply add_1;rewrite  H;assumption|apply add_2;apply H0;auto]).
  Qed.

  Lemma add_pd_transpose :
    transpose _eq (fun x : ReW r1 r2 => add (@dp r1 r2 x)).
  Proof.
    repeat red;intros.
    split;intros;
    apply add_iff in H;
    destruct H;
    try (rewrite <- H).
    abstract(apply add_2;apply add_1;auto).
    apply add_iff in H;destruct H.
    abstract(rewrite <- H;apply add_1;auto).
    abstract(do 2 apply add_2;auto).
    abstract(apply add_2;apply add_1;auto).
    apply add_iff in H;destruct H.
    abstract(rewrite <- H;apply add_1;auto).
    abstract(do 2 apply add_2;auto).
  Qed.

  Hint Resolve add_pd_transpose : typeclass_instances.

  Lemma in_powerset_PDs :
    forall (s:set (ReW r1 r2)),
      (ReW_to_set_re s)[<=]cart_prod (powerset(PD(r1))) (powerset(PD(r2))).
  Proof.
    induction s using set_induction;intros.
    red;intros.
    unfold ReW_to_set_re in H0.
    abstract(rewrite fold_1b in H0;auto;inversion H0).
    red;intros.
    unfold ReW_to_set_re in H1.
    rewrite (@fold_2 (ReW r1 r2) _ _ _ s1 s2 x (set (set re * set re)) _eq _ {}%set)
      in H1;auto with typeclass_instances.
    apply add_iff in H1.
    destruct H1.
    rewrite <- H1.
    destruct x.
    simpl.
    apply cart_prod_spec.
    destruct dp0.
    simpl in *;split.
    unfold wpdrvp in cw0.
    simpl in cw0.
    inversion cw0.
    subst.
    rewrite H5.
    rewrite wpdrv_set_singleton.
    apply powerset_spec.
    red;intros.
    unfold wpdrv in H2.
    apply all_wpdrv_in_PD with (<@w0);assumption.
    unfold wpdrvp in cw0.
    simpl in cw0.
    inversion cw0.
    subst.
    rewrite H7.
    rewrite wpdrv_set_singleton.
    apply powerset_spec.
    red;intros.
    unfold wpdrv in H2.
    apply all_wpdrv_in_PD with (<@w0);assumption.
    apply IHs1.
    assumption.
  Qed.

  Lemma in_ReW_in_set_re : forall (x:ReW r1 r2) s,
                             x \In s -> (@dp r1 r2 x) \In  (ReW_to_set_re s).
  Proof.
    induction s using set_induction;intros.
    apply H in H0.
    elim H0.
    unfold ReW_to_set_re.
    rewrite (@fold_2 (ReW r1 r2) _ _ _ s1 s2 x0 _);auto with
                                                   typeclass_instances.
    apply H0 in H1.
    destruct H1.
    apply add_1;auto.
    apply add_2.
    apply IHs1;auto.
  Qed.

  Lemma in_ReW_in_set_re_rev : forall (x:ReW r1 r2) s,
                                 (@dp r1 r2 x) \In  (ReW_to_set_re s) -> x \In s.
  Proof.
    induction s using set_induction;intros.
    unfold ReW_to_set_re in H0.
    rewrite fold_1b in H0;auto with typeclass_instances.
    inversion H0.
    unfold ReW_to_set_re in H1.
    rewrite (@fold_2 (ReW r1 r2) _ _ _ s1 s2 x0 (set (set re * set re)) _eq _ {}%set)
      in H1;auto with typeclass_instances.
    apply add_iff in H1;destruct H1.
    apply H0;auto.
    apply IHs1 in H1.
    apply H0;auto.
  Qed.

  Lemma ReW_to_set_re_same_card : forall s:set (ReW r1 r2),
                                    cardinal s = cardinal (ReW_to_set_re s).
  Proof.
    intros.
    induction s using set_induction.
    unfold ReW_to_set_re.
    rewrite fold_1b;auto with typeclass_instances.
    apply cardinal_Empty in H.
    rewrite H.
    vm_compute.
    reflexivity.
    unfold ReW_to_set_re.
    rewrite (@fold_2 (ReW r1 r2) _ _ _ s1 s2 x _);auto with
                                                  typeclass_instances.
    apply Add_Equal in H0.
    rewrite H0.
    rewrite add_cardinal_2;auto.
    rewrite add_cardinal_2;auto.
    intro.
    apply in_ReW_in_set_re_rev in H1.
    contradiction.
  Qed.

End Cardinality_Properties.

Section WellFoundedDecide.
  Variables r1 r2:re.

  Definition MAX_fst := S |<r1>|.
                          Definition MAX_snd := S |<r2>|.

                                                  Require Import NArith.

  Definition MAX := Nsucc (pow2N MAX_fst * pow2N MAX_snd)%N.

  Definition LLim := (lim_cardN (ReW r1 r2) MAX).

  Theorem LLim_wf : well_founded LLim.
  Proof.
    unfold LLim.
    apply lim_cardN_wf.
  Qed.

  Fixpoint guard (n : nat) (wf : well_founded (LLim)) :
    well_founded (LLim) :=
    match n with
      | O => wf
      | S n' => fun x => Acc_intro x (fun y _ => guard n' (guard n' wf) y)
    end.

End WellFoundedDecide.

Section DecreasingMeasures.
  Variables r1 r2:re.

  Lemma disj_h_s_inv :
    forall (h s : set (ReW r1 r2)) (sig : set Z),
      inter h s === {} -> inter (fst (fst (StepFast' _ _ h s sig)))
                                (snd (fst (StepFast' _ _ h s sig))) === {}.
  Proof.
    intros.
    split;intros.
    apply inter_iff in H0.
    destruct H0 as [H1 H2].
    revert H1 H2.
    unfold StepFast';simpl in *.
    case_eq(choose s).
    intros r Hr.
    destruct(c_of_ReW _ _ r);simpl in *.
    apply choose_1 in Hr.
    intros H1 H2;apply add_iff in H1;destruct H1.
    apply union_1 in H2;destruct H2.
    apply ReW_pdrv_set_filtered_no_dup in H1.
    rewrite H0 in H1.
    elim H1.
    apply add_1;reflexivity.
    apply remove_iff in H1.
    destruct H1;contradiction.
    apply union_1 in H2;destruct H2.
    apply ReW_pdrv_set_filtered_no_dup in H1.
    elim H1.
    apply add_2;assumption.
    apply remove_iff in H1;destruct H1.
    (*apply e;apply inter_iff;split;auto.*)
    assert(a \In inter h s) by (apply inter_iff;split;auto).
    apply H in H3;inversion H3.
    intros;apply H.
    apply inter_iff;auto.
    simpl.
    intros.
    assert(a \In inter h s) by (apply inter_iff;split;auto).
    apply H in H3;inversion H3.
    inversion H0.
  Qed.

  Lemma c_of_Rew_set_h_inv : forall (h s : set (ReW r1 r2)) (sig : set Z),
                               inter h s === {} -> c_of_ReW_set _ _ h = true ->
                               c_of_ReW_set _ _ (fst (fst (StepFast' _ _ h s sig))) = true.
  Proof.
    intros.
    case_eq(choose s);intros.
    case_eq(%e_rew r);intros.
    unfold StepFast'.
    rewrite H1,H2.
    simpl.
    unfold c_of_ReW_set.
    rewrite fold_add;auto with typeclass_instances.
    rewrite H2;simpl.
    exact H0.
    repeat red.
    intros.
    destruct(%e_rew x).
    simpl.
    reflexivity.
    simpl.
    rewrite andb_comm;simpl.
    reflexivity.
    intro.
    apply choose_1 in H1.
    assert(r \In inter h s).
    apply inter_iff;auto with typeclass_instances.
    apply H in H4;inversion H4.
    unfold StepFast'.
    rewrite H1,H2.
    simpl.
    exact H0.
    unfold StepFast'.
    rewrite H1.
    simpl.
    assumption.
  Qed.

  Lemma DP_upd : forall (h s : set (ReW r1 r2)) (sig : set Z),
                   DP _ _ h s ->
                   DP _ _ (fst (fst (StepFast' _ _ h s sig)))
                      (snd (fst (StepFast' _ _ h s sig))).
  Proof.
    intros.
    destruct H.
    constructor.
    apply disj_h_s_inv with (sig:=sig) in H.
    exact H.
    apply c_of_Rew_set_h_inv;assumption.
  Qed.

  Lemma  cardinal_less_than_pow2 : forall h,
                                     cardinal (ReW_to_set_re r1 r2 h) <= pow2 (MAX_fst r1) * pow2 (MAX_snd r2).
  Proof.
    intros.
    generalize(in_powerset_PDs r1 r2 h).
    intro.
    eapply Le.le_trans with
    (cardinal (cart_prod (powerset (PD r1)) (powerset (PD r2)))).
    apply subset_cardinal.
    assumption.
    rewrite cart_prod_card.
    unfold MAX_fst,MAX_snd.
    do 2 rewrite pow2_S.
    do 2 rewrite powerset_cardinal.
    generalize( PD_upper_bound r1).
    generalize( PD_upper_bound r2).
    intros.
    apply pow2_le in H0.
    apply pow2_le in H1.
    rewrite pow2_S in H0,H1.
    apply Mult.mult_le_compat;assumption.
  Qed.

  Lemma LLim_disj_h_s : forall (h s : set (ReW r1 r2)) (sig : set Z),
                          inter h s === {} -> snd (StepFast' _ _ h s sig) = Process' _ _->
                          LLim _ _ (fst (fst (StepFast' _ _ h s sig))) h.
  Proof.
    intros h s sig D.
    case_eq(choose s);intros r Hr.
    case_eq(c_of_ReW _ _ r);simpl;intros.
    unfold LLim,lim_cardN.
    (*destruct D.*)
    revert H0.
    unfold StepFast'.
    rewrite Hr.
    rewrite H.
    intro.
    Opaque MAX.
    simpl.
    apply choose_1 in Hr.
    assert(~r \In h).
    intro.
    assert(r \In inter h s) by (apply inter_iff;split;auto).
    apply D in H2;inversion H2.
    rewrite add_cardinal_2;auto.
    rewrite  ReW_to_set_re_same_card.
    Transparent MAX.
    clear H0.
    generalize(in_powerset_PDs _ _ h);intro.
    apply subset_cardinal in H0.
    generalize(cardinal_less_than_pow2 h);intro.
    unfold MAX.
    rewrite Nnat.nat_of_Nsucc.
    rewrite Nnat.nat_of_Nmult.
    do 2 rewrite pow2_pow2N_equiv.
    abstract omega.
    unfold StepFast' in H0.
    rewrite Hr,H in H0.
    abstract discriminate.
    unfold StepFast' in Hr.
    rewrite r in Hr.
    abstract discriminate.
  Qed.

  Lemma DP_wf : forall (h s : set (ReW r1 r2)) (sig : set Z),
                  DP _ _ h s -> snd (StepFast' _ _ h s sig) = Process' _ _ ->
                  LLim _ _ (fst (fst (StepFast' _ _ h s sig))) h.
  Proof.
    intros.
    destruct H.
    apply LLim_disj_h_s.
    exact H.
    exact H0.
  Qed.

End DecreasingMeasures.

Section Iterator.
  Variables r1 r2:re.

  Inductive LastCases : Type :=
    Ok : set (ReW r1 r2) -> LastCases | NotOk : ReW r1 r2 -> LastCases.

  (* begin show *)
  Function decide_re_ref'(h s:set (ReW r1 r2))
           (sig:set Z)(D:DP _ _ h s){wf (LLim r1 r2) h}: LastCases :=
    let f := StepFast' _ _ h s sig in
    let next := snd f in
    let HistStack := (fst f) in
    match next  with
      | TermFalse' x => NotOk x
      | TermTrue' h  => Ok h(*(fst HistStack)*)
      | Process'  => decide_re_ref' (fst HistStack) (snd HistStack)
                                    sig (DP_upd _ _ h s sig D)
    end.
  Proof.
    abstract(apply DP_wf).
    exact(guard r1 r2 100 (LLim_wf r1 r2)).
  Defined.
(* end show *)

End Iterator.

Section ResultContainsOriginal.
  Variables r1 r2: re.

  Lemma decide_re_ref'_1 : forall s h sig D,
                           forall x , decide_re_ref' _ _ h s sig D = x ->
                                      forall r s', StepFast' _ _ h s sig = (({r;h},s'),Process' r1 r2) ->
                                                   forall D', decide_re_ref' _ _ {r;h} s' sig D' = x.
  Proof.
    intros.
    rewrite decide_re_ref'_equation in H.
    pattern (StepFast' _ _ h s sig) at 1 in H.
    rewrite H0 in H.
    (* Truque acelera a gravacao da prova. Caso use [simpl] a gravacao
         da funcao nao sei se termina. *)
    assert(match snd ({r; h}, s',Process' _ _) with
             | Process' =>
               decide_re_ref' _ _ (fst (fst (StepFast' _ _ h s sig)))
                              (snd (fst (StepFast' _ _ h s sig))) sig
                              (DP_upd _ _ h s sig D)
             | TermTrue' h => Ok _ _ h
             | TermFalse' x => NotOk _ _ x
           end = x -> (decide_re_ref' _ _ (fst (fst (StepFast' _ _ h s sig)))
                                      (snd (fst (StepFast' _ _ h s sig))) sig
                                      (DP_upd _ _ h s sig D) = x)).
    abstract (simpl;auto).
    generalize(H1 H).
    intro.
    clear H H1.
    revert H2.
    generalize(DP_upd _ _ h s sig D).
    generalize(D').
    rewrite H0.
    simpl.
    intros.
    assert(d=D'0).
    apply proof_irrelevance.
    rewrite <- H.
    assumption.
  Qed.

  Lemma in_first_ref : forall s h sig D x,
                         decide_re_ref' _ _ h s sig D = Ok r1 r2 x -> h[<=]x.
  Proof.
    intros.
    functional induction (decide_re_ref' r1 r2 h s sig D).
    discriminate.
    injection H;intro;subst;clear H.
    revert e.
    unfold StepFast'.
    case_eq(choose s);intros r Hr.
    case_eq(%e_rew r);intro.
    discriminate.
    discriminate.
    simpl in Hr.
    injection Hr;intros.
    subst.
    intuition.
    generalize(IHl H);intro;clear IHl.
    transitivity (fst (fst (StepFast' r1 r2 h s sig)));auto.
    revert e.
    unfold StepFast'.
    case_eq(choose s);intros r Hr.
    case_eq(%e_rew r);intro.
    simpl.
    intro.
    red;intros.
    apply add_2;auto.
    discriminate.
    discriminate.
  Qed.

  Lemma in_first_step_fast' : forall s h sig D x r,
                                decide_re_ref' r1 r2 h s sig D = Ok r1 r2 x -> choose s = Some r ->
                                {r;h}[<=]x.
  Proof.
    intros.
    assert(DP r1 r2 {r; h} (r %dF[ {r; h}, sig ] ++ (remove r s))).
    destruct D.
    constructor.
    split;intros.
    apply inter_iff in H1.
    destruct H1.
    apply union_1 in H2.
    destruct H2.
    apply ReW_pdrv_set_filtered_no_dup in H2.
    contradiction.
    apply remove_iff in H2.
    destruct H2.
    apply add_iff in H1.
    destruct H1.
    contradiction.
    assert(a \In inter h s).
    apply inter_iff;split;auto.
    (*destruct d.*)
    apply e in H4;inversion H4.
    inversion H1.
    case_eq(%e_rew r);intro.
    unfold c_of_ReW_set.
    rewrite fold_add;auto with typeclass_instances.
    rewrite H1.
    simpl.
    exact e0.
    repeat red.
    intros.
    destruct(%e_rew x0).
    simpl.
    reflexivity.
    simpl.
    rewrite andb_comm.
    simpl;reflexivity.
    intro.
    apply choose_1 in H0.
    assert(r \In inter h s).
    apply inter_iff;split;auto with typeclass_instances.
    apply e in H3.
    inversion H3.
    rewrite decide_re_ref'_equation in H.
    revert H.
    generalize(is_dpt r1 r2 h s e e0).
    unfold StepFast'.
    intro.
    generalize(DP_upd r1 r2 h s sig d).
    unfold StepFast'.
    rewrite H0,H1.
    discriminate.
    revert H.
    rewrite decide_re_ref'_equation.
    generalize(DP_upd r1 r2 h s sig D).
    unfold StepFast'.
    rewrite H0.
    case_eq(%e_rew r).
    intro.
    simpl.
    intros.
    apply in_first_ref in H2.
    assumption.
    simpl.
    discriminate.
  Qed.

  Lemma in_first_stepfast' : forall s h sig D x r,
                               decide_re_ref' r1 r2 h s sig D = Ok r1 r2 x -> choose s = Some r ->
                               {r;h}[<=]x.
  Proof.
    intros.
    assert(StepFast' r1 r2 h s sig =
           (({r;h},r %dF[ {r;h}, sig ] ++ (remove r s)),Process' r1 r2)).
    unfold StepFast'.
    rewrite H0.
    case_eq(%e_rew r);intro.
    reflexivity.
    rewrite decide_re_ref'_equation in H.
    revert H.
    generalize(DP_upd r1 r2 h s sig D).
    unfold StepFast'.
    rewrite H0.
    rewrite H1.
    simpl.
    discriminate.
    assert(DP r1 r2 {r; h} (r %dF[ {r; h}, sig ] ++ (remove r s))).
    destruct D.
    (*destruct d.*)
    constructor.
    (*constructor.*)
    split;intros.
    apply inter_iff in H2.
    destruct H2.
    apply union_1 in H3.
    destruct H3.
    apply ReW_pdrv_set_filtered_no_dup in H3.
    contradiction.
    apply remove_iff in H3.
    destruct H3.
    apply add_iff in H2.
    destruct H2.
    contradiction.
    assert(a \In inter h s).
    apply inter_iff;split;auto.
    apply e in H5;inversion H5.
    inversion H2.
    case_eq(%e_rew r);intro.
    unfold c_of_ReW_set.
    rewrite fold_add;auto with typeclass_instances.
    rewrite H2.
    simpl.
    exact e0.
    repeat red.
    intros.
    destruct(%e_rew x0).
    simpl.
    reflexivity.
    simpl.
    rewrite andb_comm.
    simpl;reflexivity.
    intro.
    apply choose_1 in H0.
    assert(r \In inter h s).
    apply inter_iff;split;auto with typeclass_instances.
    apply e in H4.
    inversion H4.
    unfold StepFast' in H1.
    rewrite H0,H2 in H1.
    discriminate.
    generalize(decide_re_ref'_1 _ _ _ _ _ H r _ H1 H2).
    intro.
    generalize(in_first_step_fast' _ _ _ _ _ r H H0);auto.
  Qed.

  Lemma decide_re_ref'_contains_orig_aux : forall sig D x r,
                                             decide_re_ref' r1 r2 {}%set {ReW_1st r1 r2}%set sig D = Ok r1 r2 x ->
                                             choose {ReW_1st r1 r2}%set = Some r ->
                                             ReW_1st r1 r2 \In x.
  Proof.
    intros.
    assert(forall r, choose {ReW_1st r1 r2}%set = Some r ->
                     r === ReW_1st r1 r2).
    intros.
    apply choose_1 in H1.
    apply singleton_1 in H1;auto.
    generalize(H1 _ H0).
    intro.
    generalize(in_first_step_fast' _ _ _ _ x r H H0).
    intro.
    apply H3.
    apply add_1.
    assumption.
  Qed.

  Lemma decide_re_ref'_contains_orig_hip : forall sig D x,
                                             decide_re_ref' r1 r2 {}%set {ReW_1st r1 r2}%set sig D = Ok r1 r2 x ->
                                             exists r, choose {ReW_1st r1 r2}%set = Some r.
  Proof.
    intros.
    rewrite decide_re_ref'_equation in H.
    unfold StepFast' at 1 in H.
    case_eq(choose {ReW_1st r1 r2});intros.
    rewrite H0 in H.
    case_eq(%e_rew r);intro.
    rewrite H1 in H.
    simpl in H.
    exists r;auto.
    rewrite H1 in H.
    simpl in H.
    discriminate.
    rewrite H0 in H.
    simpl in H.
    apply choose_2 in H0.
    elim (H0 (ReW_1st r1 r2)).
    apply singleton_2;auto.
  Qed.

  Lemma decide_re_ref'_contains_orig : forall sig D x,
                                         decide_re_ref' r1 r2 {}%set {ReW_1st r1 r2}%set sig D = Ok r1 r2 x ->
                                         ReW_1st r1 r2 \In x.
  Proof.
    intros.
    destruct (decide_re_ref'_contains_orig_hip sig D x).
    assumption.
    exact(decide_re_ref'_contains_orig_aux sig D x x0 H H0).
  Qed.

End ResultContainsOriginal.

Require Import symbs.

Section IteratorInvariant.
  Variables r1 r2:re.

  Global Instance not_in_set_add_m :
    forall r h, Proper (_eq ==> eq) (fun x : ReW r1 r2 => negb (x \in {r; h})).
  Proof.
    repeat red;intros.
    rewrite H.
    reflexivity.
  Qed.

  (** Invariant of [decide_re]. *)
  Definition invP'(h s:set (ReW r1 r2))(sig:set Z) :=
    forall x, x \In h ->
              forall a, a \In sig -> (ReW_pdrv r1 r2 x a) \In (h ++ s).

  (** Invariant enriched with correctness criteria of [c_of_ReW]. *)
  Definition invP_final'(h s:set (ReW r1 r2))(sig:set Z) :=
    (ReW_1st r1 r2) \In (h ++ s) /\
    (forall x, x \In (h++s) -> c_of_ReW r1 r2 x = true) /\ invP' h s sig.

  Lemma invP_inv' : forall h s (sig:set Z),
                      invP' h s sig ->
                      invP' (fst (fst (StepFast' r1 r2 h s sig)))
                            (snd (fst (StepFast' r1 r2 h s sig))) sig.
  Proof.
    intros *.
    case_eq(choose s);intros.
    unfold invP' in H0.
    unfold StepFast'.
    rewrite H.
    case_eq(%e_rew r);intros.
    simpl.
    unfold invP';intros.
    destruct(@In_dec (ReW r1 r2) _ _ _ (ReW_pdrv _ _ x a) h).
    apply union_2.
    apply add_2;auto.
    apply add_iff in H2;destruct H2.
    destruct(eq_dec (x %d[a]) x).
    rewrite H4.
    apply union_2;apply add_1;auto.
    apply union_3.
    apply union_2.
    apply filter_iff;auto with typeclass_instances.
    split.
    rewrite <- H2.
    apply ReW_in_pdrv_set.
    assumption.
    apply Bool.eq_true_not_negb.
    intro.
    apply mem_iff in H5.
    apply add_iff in H5.
    destruct H5.
    rewrite H2 in H5.
    symmetry in H5.
    contradiction.
    contradiction.
    generalize(H0 _ H2 _ H3).
    intro.
    apply union_1 in H4.
    destruct H4.
    contradiction.
    destruct(eq_dec (x %d[a]) r).
    rewrite H5.
    apply union_2.
    apply add_1;reflexivity.
    apply union_3.
    apply union_3.
    apply remove_iff.
    split.
    assumption.
    intro.
    symmetry in H6;contradiction.
    simpl.
    assumption.
    unfold StepFast'.
    rewrite H.
    simpl.
    assumption.
  Qed.

  Lemma invP_decide_re_correct' :
    forall h s sig D x,
      invP' h s sig -> decide_re_ref' r1 r2 h s sig D = Ok r1 r2 x ->
      invP' x {}%set sig.
  Proof.
    intros.
    functional induction (decide_re_ref' r1 r2 h s sig D).
    discriminate.
    case_eq(choose s);intros.
    unfold StepFast' in e.
    rewrite H1 in e.
    case_eq(%e_rew r);intros.
    rewrite H2 in e.
    discriminate.
    rewrite H2 in e.
    discriminate.
    unfold StepFast' in e.
    rewrite H1 in e.
    simpl in e.
    injection e;injection H0;intros;subst.
    clear H0 e.
    unfold invP' in H.
    unfold invP'.
    intros.
    generalize(H x0 H0 _ H2).
    intro.
    apply choose_2 in H1.
    apply empty_is_empty_1 in H1.
    rewrite H1 in H3.
    assumption.
    apply IHl.
    apply invP_inv'.
    assumption.
    assumption.
  Qed.

  Definition mkDP_ini : DP r1 r2 ({}%set) ({ReW_1st r1 r2}%set).
  Proof.
    constructor.
    split;intros;try abstract(inversion H).
    vm_compute.
    reflexivity.
  Defined.

  Lemma invP'_decide_re_initial_correct : forall x,
                                            decide_re_ref' r1 r2 {}%set {ReW_1st r1 r2}%set
                                                           (ss r1 ++ ss r2) (mkDP_ini) = Ok r1 r2 x ->
                                            invP' x {}%set (ss r1 ++ ss r2).
  Proof.
    intros.
    eapply (invP_decide_re_correct' {} {ReW_1st r1 r2}  (ss r1 ++ ss r2) mkDP_ini).
    unfold invP'.
    intros.
    abstract(inversion H0).
    apply H.
  Qed.

End IteratorInvariant.

Section CorrectnessArgument.
  Variables r1 r2 : re.

  (* ESTE TEM QUE SAIR DAQUI E IR PARA O dsr_dsl.v *)
  Lemma c_of_re_set_singleton :
    forall s, εs({s}%set) = ε(s).
  Proof.
    intros.
    case_eq(c_of_re_set {s});intro.
    apply c_of_re_set_true in H.
    do 2 destruct H.
    apply singleton_1 in H.
    rewrite H.
    rewrite H0;auto.
    generalize(c_of_re_set_false _ H).
    intro.
    assert(s \In {s}%set).
    apply singleton_2;auto.
    apply H0 in H1.
    rewrite H1;auto.
  Qed.

  Lemma leibniz_word : forall w1 w2:word,
                         w1 === w2 -> w1 = w2.
  Proof.
    induction 1.
    reflexivity.
    normalize_notations.
    inv H.
  Qed.

  Lemma invP_final_eq_lang' :
    forall x,
      decide_re_ref' r1 r2 {}%set {ReW_1st r1 r2}%set (ss r1 ++ ss r2) (mkDP_ini r1 r2)
      = Ok r1 r2 x ->
      invP_final' r1 r2 x {}%set (ss r1 ++ ss r2) -> r1 ∼ r2.
  Proof.
    intros.
    unfold invP_final' in H0.
    destruct H0 as [H1 [H2 H3]].
    unfold invP' in H3.
    assert(ReW_1st r1 r2 \In x).
    apply union_1 in H1;destruct H1.
    assumption.
    abstract(inversion H0).
    clear H1.
    assert(forall x0 : ReW r1 r2, x0 \In x -> c_of_ReW _ _ x0 = true).
    intros.
    apply H2.
    apply union_2;auto.
    clear H2.
    assert(forall x0 : ReW r1 r2,
             x0 \In x -> forall a : Z, a \In (ss r1 ++ ss r2) -> x0 %d[ a ] \In x).
    intros.
    generalize(H3 _ H2 _ H4);intro.
    apply union_iff in H5;destruct H5.
    assumption.
    abstract(inversion H5).
    clear H3.
    assert(forall w, (@>w) ∈ langSsy (ss r1 ++ ss r2) -> ReW_wpdrv r1 r2 (@>w) \In x).
    induction w0.
    simpl.
    assert(ReW_wpdrv r1 r2 [] === ReW_1st r1 r2) by
        (vm_compute;split;intros;auto).
    intro.
    rewrite H3.
    assumption.
    simpl.
    rewrite ReW_wpdrv_step.
    intro.
    eapply H2.
    apply IHw0.
    apply word_concat_sy_in_langSsy in H3.
    destruct H3;auto.
    apply word_concat_sy_in_langSsy in H3;
      destruct H3;auto.
    inversion_clear H4.
    assumption.

    assert(forall w, w ∈ langSsy (ss r1 ++ ss r2) ->
                     ReW_wpdrv r1 r2 w \In x).
    intro.
    generalize(ListFromIlist w0).
    intro.
    assert(ReW_wpdrv r1 r2 w0 === ReW_wpdrv r1 r2 (@>(<@w0))).
    red.
    unfold _eq.
    simpl.
    red in H4.
    unfold _eq in H4;simpl in H4.
    unfold ReW_eq.
    simpl.
    normalize_notations.
    apply leibniz_word in H4.
    rewrite H4.
    reflexivity.
    intros.
    rewrite H5.
    apply H3.
    apply leibniz_word in H4.
    rewrite H4.
    assumption.

    assert(forall w, w ∈ langSsy (ss r1 ++ ss r2) -> c_of_ReW _ _ (ReW_wpdrv r1 r2 w) = true).
    intros.
    apply H1.
    apply H4.
    assumption.
    assert(forall w,  w ∈ langSsy (ss r1 ++ ss r2) -> c_of_re_set (wpdrv r1 w) = c_of_re_set (wpdrv r2 w)).
    intros.
    specialize H5 with w0.
    unfold c_of_ReW in H5;simpl in H5.
    unfold wpdrvp in H5;simpl in H5.
    unfold c_of_rep in H5;simpl in H5.
    do 2 rewrite wpdrv_set_singleton in H5.
    apply Bool.eqb_prop in H5.
    assumption.
    assumption.
    clear H3 H H0 H1 H2 H4 H5.
    apply word_of_langSsy_decide_equiv.
    apply H6.
  Qed.

  Definition equiv_re_ref_aux'(h s:set (ReW r1 r2))
             (sig:set Z)(D:DP r1 r2 h s) :=
    let H := decide_re_ref' r1 r2 h s sig D in
    match H with
      | Ok _ => true
      | _ => false
    end.

  Definition equiv_re_ref' (sig:set Z) :=
    equiv_re_ref_aux' {}%set {ReW_1st r1 r2}%set sig (mkDP_ini r1 r2).

  Definition equivP := equiv_re_ref' (ss r1 ++ ss r2).

  Lemma decide_ref_subset_decide_re_all_c : forall h s sig D x,
                                              decide_re_ref' r1 r2 h s sig D = Ok r1 r2 x -> c_of_ReW_set r1 r2 x = true.
  Proof.
    intros.
    functional induction (decide_re_ref' r1 r2 h s sig D).
    abstract discriminate.
    injection H;intros.
    rewrite H0 in e.
    (*clear H H0 h0.*)
    revert e.
    unfold StepFast'.
    case_eq(choose s).
    intros r Hr.
    case_eq(%e_rew r);simpl;intros.
    abstract discriminate.
    abstract discriminate.
    simpl;intros.
    injection e;intros.
    destruct D.
    rewrite H2 in H4. (*;clear H H0.*)
    exact H4.
    exact(IHl H).
  Qed.

  Lemma correct_aux_1 : forall s,
                          decide_re_ref' r1 r2 {}%set {ReW_1st r1 r2}%set (ss r1 ++ ss r2)
                                         (mkDP_ini r1 r2)
                          = Ok r1 r2 s -> equiv_re_ref' (ss r1 ++ ss r2) = true.
  Proof.
    intros.
    unfold equiv_re_ref'.
    unfold equiv_re_ref_aux'.
    rewrite H.
    reflexivity.
  Qed.

  Lemma correct_aux_2 : forall s,
                          decide_re_ref' r1 r2 {}%set {ReW_1st r1 r2}%set (ss r1 ++ ss r2)
                                         (mkDP_ini r1 r2)
                          = NotOk r1 r2 s -> equiv_re_ref' (ss r1 ++ ss r2) = false.
  Proof.
    intros.
    unfold equiv_re_ref'.
    unfold equiv_re_ref_aux'.
    rewrite H.
    reflexivity.
  Qed.

  Lemma decide_ref_subset_decide_re_not_ok : forall h s sig D x,
                                               decide_re_ref' r1 r2 h s sig D = NotOk r1 r2 x -> %e_rew x = false.
  Proof.
    intros.
    functional induction (decide_re_ref' r1 r2 h s sig D).
    injection H;clear H;intros.
    subst.
    revert e.
    unfold StepFast'.
    case_eq(choose s).
    intros r Hr.
    case_eq(%e_rew r);intro.
    discriminate.
    intros.
    injection e;intros;subst.
    assumption.
    discriminate.
    discriminate.
    apply IHl in H.
    assumption.
  Qed.

End CorrectnessArgument.

Section EquivPCorrectness.
  Variables r1 r2 : re.

  Lemma equiv_re_true : equiv_re_ref' r1 r2 (ss r1 ++ ss r2) = true -> r1 ∼ r2.
  Proof.
    intro.
    case_eq(decide_re_ref' r1 r2 {} {ReW_1st r1 r2} (ss r1 ++ ss r2) (mkDP_ini r1 r2)).
    intros s H1.

    apply invP_final_eq_lang' with (x:=s).
    exact H1.
    split.
    abstract(apply union_2;
             exact(decide_re_ref'_contains_orig r1 r2 (ss r1 ++ ss r2) (mkDP_ini r1 r2) s H1)).
    split;intros.
    abstract(apply decide_ref_subset_decide_re_all_c in H1;
             apply union_1 in H0;destruct H0;[
               exact(wit_all_in_c_of_ReW_set r1 r2 s H1 x H0)|
               inversion H0]).
    abstract(apply invP'_decide_re_initial_correct in H1;
             exact H1).

    intros.
    apply correct_aux_2 in H0.
    rewrite H0 in H.
    abstract(discriminate).
  Qed.

  Lemma equiv_re_false : equiv_re_ref' r1 r2 (ss r1 ++ ss r2) = false -> r1 !∼ r2.
  Proof.
    intros.
    case_eq(decide_re_ref' r1 r2 {} {ReW_1st r1 r2} (ss r1 ++ ss r2) (mkDP_ini r1 r2));
      intros.
    apply correct_aux_1 in H0.
    abstract(rewrite H0 in H;discriminate).
    apply decide_ref_subset_decide_re_not_ok in H0.
    apply  c_of_ReW_diff_wpdrvs_Srels in H0.
    exact H0.
  Qed.

End EquivPCorrectness.

Section EquivPCompleteness.
  Variables r1 r2:re.

  Theorem equiv_re_complete_true : r1 ∼ r2 ->
                                   equiv_re_ref' r1 r2 (ss r1 ++ ss r2) = true.
  Proof.
    intros.
    case_eq(equiv_re_ref' r1 r2 (ss r1 ++ ss r2));intros.
    reflexivity.
    apply equiv_re_false in H0.
    contradiction.
  Qed.

  Lemma equiv_re_complete_false : r1 !∼ r2 ->
                                  equiv_re_ref' r1 r2 (ss r1 ++ ss r2) = false.
  Proof.
    intros.
    case_eq(equiv_re_ref' r1 r2 (ss r1 ++ ss r2));intros.
    apply equiv_re_true in H0.
    contradiction.
    reflexivity.
  Qed.

End EquivPCompleteness.

(** * The automatic proof tactic [dec_equivP] *)
Ltac re_inequiv :=
  apply equiv_re_false;vm_compute;
  first [ reflexivity | fail 2 "Regular expressions not inequivalent" ].

Ltac re_equiv :=
  apply equiv_re_true;vm_compute;
  first [ reflexivity | fail 2 "Regular expressions are not equivalent" ].

Ltac dec_re :=
  match goal with
    | |- re2rel (?R1) ∼ re2rel (?R2) => re_equiv
    | |- re2rel (?R1) !∼ re2rel (?R2) => re_inequiv
    | |- re2rel (?R1) ≤ re2rel (?R2) =>
      unfold lleq;change (R1 ∪ R2) with (re2rel (R1 + R2));
      re_equiv
    | |- _  => fail 2 "Not a regular expression (in-)equivalence equation."
  end.


Require Import VST.msl.base.
Require Import VST.msl.sepalg.
Require Import VST.msl.predicates_sa.

Definition covariant {B A : Type} (F: (B -> pred A) -> (B -> pred A)) : Prop :=
forall (P Q: B -> pred A), (forall x, P x |-- Q x) -> (forall x, F P x |-- F Q x).

Definition corec {B A: Type}  (F: (B -> pred A) -> (B -> pred A)) : B -> pred A :=
fun x w => forall P: B -> pred A, (forall x, F P x |-- P x) -> P x w.

Lemma corec_fold_unfold {B A}:
forall {F: (B -> pred A) -> (B -> pred A)},
       covariant F ->
        corec F = F (corec F).
Proof.
intros.
assert (forall x, F (corec F) x |-- corec F x).
2:{
extensionality x.
apply pred_ext; intros w ?.
apply H1. intros x' ? ?.
eapply H.  eapply H0.
replace (F (corec F)) with (fun (x : B) (w : A) => F (corec F) x w); auto.
apply H0; auto.
}
intros x ? ?.
intros ? ?.
specialize (H (corec F) P).
apply H1. apply H; auto.
intros x' ? ?.
apply H2; auto.
Qed.

Lemma corec_least_fixpoint {B A}:
forall {F: (B -> pred A) -> (B -> pred A)}, forall {P : B -> pred A},
  P = F P ->
  forall b, corec F b |-- P b.
Proof.
  intros. do 2 intro.
  apply H0 with (P := P). intros b' ? ?.
  rewrite H. apply H1.
Qed.

Lemma covariant_sepcon {B}{A} {JA: Join A}{PA: Perm_alg A}:
   forall P Q : (B -> pred A) -> (B -> pred A),
    covariant P -> covariant Q ->
    covariant (fun (x : B -> pred A) b => P x b * Q x b)%pred.
Proof.
intros. intros R S ? ?.
eapply sepcon_derives; auto.
Qed.

Lemma covariant_const {B A}:    forall P : B -> pred A, covariant (fun _ => P).
Proof.
intros. intros R S ?. auto.
Qed.

Lemma covariant_orp {B A}:  forall P Q: (B -> pred A)-> (B -> pred A),
      covariant P -> covariant Q -> covariant (fun x b => P x b || Q x b)%pred.
Proof.
intros. intros R S ? ?.
intros w [H2|H2]; [left; eapply H | right; eapply H0]; try apply H1; eauto.
Qed.

Lemma covariant_andp {B A}:  forall P Q: (B -> pred A) -> (B -> pred A),
      covariant P -> covariant Q -> covariant (fun x b => P x b && Q x b)%pred.
Proof.
intros. intros R S ? ?.
apply andp_derives; auto.
Qed.

Lemma covariant_exp {C B A}: forall F: C -> (B -> pred A) -> (B -> pred A),
  (forall c, covariant (F c)) ->
   covariant (fun P b => EX c:C, F c P b)%pred.
Proof.
intros.
repeat intro.
destruct H1 as [b ?].
exists b. specialize (H b).
unfold covariant in H.
apply (H P Q H0). auto.
Qed.

Lemma covariant_id {B A}: covariant (fun F: B -> pred A => F).
Proof.
unfold covariant; auto.
Qed.

Lemma covariant_const' {B A}:
  forall c:B,  covariant (fun (P: B -> pred A) _ => P c).
Proof.
repeat intro.
apply H; auto.
Qed.


Require Import Program Div2 Omega.
Require Import Arith Arith.Even Arith.Div2 NPeano.
Require Import Coq.Program.Wf Init.Wf.
Require Import Coq.Arith.Max.
Require Import Coq.Arith.Mult.
Require Import Braun.common.util Braun.common.le_util.
Require Import Braun.common.log Braun.common.big_oh Braun.common.pow.
Require Import Braun.monad.monad Braun.arith.plus.

Include WfExtensionality.

Program Fixpoint tmult_time (n:nat) (m:nat) {measure n} :=
  match n with
    |0 => 1
    |S _ => if (even_odd_dec n)
            then (tmult_time (div2 n) m) + 1
            else
              (tmult_time (div2 n) m) +
              (plus_time_ub m (double ((div2 n)*m))) + 1
  end.

Definition tmult_result n m res (c:nat):= n*m = res /\ c <= tmult_time n m.
Hint Unfold tmult_result.
Load "mult_gen.v".

Lemma double_times : forall n m, double (n*m) = (double n) * m.
Proof.
  intros.
  unfold double.
  rewrite mult_plus_distr_r.
  auto.
Qed.

Lemma even_tmult_time :  forall n m,
                          Even.even (S n) -> tmult_time (S n) m = tmult_time (div2 (S n)) m +1.
Proof.
  intros.
  unfold tmult_time.
  unfold tmult_time_func.
  rewrite fix_sub_eq_ext.
  fold tmult_time_func.
  simpl proj1_sig.
  unfold projT1.
  dispatch_if EW' EW'; auto.
  assert False.
  apply not_even_and_odd with (S n); auto.
  intuition.
Qed.

Next Obligation.
Proof.
  unfold tmult_result in *.
  split.
  destruct H1.
  rewrite <- H0.
  rewrite double_times.
  assert  (double (div2 (S wildcard')) = (S wildcard')).
  apply eq_sym.
  apply even_double.
  apply H.
  rewrite H3.
  auto.
  destruct H1.
  rewrite even_tmult_time.
  rewrite plus_comm.
  assert (tmult_time (div2 (S wildcard')) m + 1 = 1 +  tmult_time (div2 (S wildcard')) m).
  rewrite plus_comm.
  auto.
  rewrite H3.
  apply plus_le_compat_l.
  apply H1. apply H.
Qed.

Lemma plus_succ : forall n, S n = n + 1.
Proof.
  intros.
  rewrite plus_comm.
  auto.
Qed.

Lemma odd_tmult_time : forall n m,
                        Even.odd (S n) ->
                        tmult_time (S n) m =
                        (tmult_time (div2 (S n)) m) +
                        (plus_time_ub m (double ((div2 (S n))*m))) + 1.
Proof.
  intros.
  unfold tmult_time.
  unfold tmult_time_func.
  rewrite fix_sub_eq_ext.
  fold tmult_time_func.
  simpl proj1_sig.
  unfold projT1.
  dispatch_if EW' EW'; auto.
  assert False.
  apply not_even_and_odd with (S n); auto.
  exfalso. apply H0.
Qed.

Next Obligation.
Proof.
  unfold tmult_result in *.
  split.
  unfold tplus_result in *.
  destruct H3.
  destruct H4.
  rewrite H0.
  rewrite <- H4.
  rewrite double_times.
  rewrite plus_comm.
  assert  (S wildcard' = S (double (div2 (S wildcard')))).
  apply odd_double.
  auto.
  rewrite H6 at 1.
  rewrite plus_succ.
  rewrite mult_plus_distr_r.
  rewrite mult_1_l.
  auto.
  unfold tplus_result in *.
  clear H3 H4.
  destruct H1.
  destruct H2.
  rewrite odd_tmult_time.
  rewrite <- plus_assoc.
  apply plus_le_compat.
  apply H3.
  apply plus_le_compat.
  rewrite H2.
  apply H1.
  auto.
  auto.
Qed.

Program Fixpoint tmult_time2 (n:nat) (m:nat) {measure n} :=
  match n with
    |0 => 1
    |S _ =>
     (tmult_time2 (div2 n) m) +
     (plus_time_ub m (double ((div2 n)*m))) + 1
  end.

Lemma tmult_time2_Sn : forall n m, tmult_time2 (S n) m =
                                   (tmult_time2 (div2 (S n)) m) +
                                   (plus_time_ub m (double ((div2 (S n))*m))) + 1.
Proof.
  intros.
  unfold tmult_time2.
  unfold tmult_time2_func.
  rewrite fix_sub_eq_ext.
  fold tmult_time2_func.
  simpl proj1_sig.
  unfold projT1.
  auto.
Qed.

Lemma double_div2 : forall n, double (div2 n) <= n.
  Proof.
    intros.
    destruct (even_odd_dec n).
    rewrite <- even_double ; auto.
    rewrite odd_double ; auto.
  Qed.

Lemma tmult_time_1_2 : big_O2 tmult_time tmult_time2.
  Proof.
    exists 0.
    exists 1.
    intros n m _ _.
    rewrite mult_1_l.
    apply (well_founded_ind
             lt_wf
             (fun n => forall m, tmult_time n m <= tmult_time2 n m)).
    clear.
    intros n IND.
    destruct n.
    auto.
    destruct (even_odd_dec (S n)).
    intros.
    rewrite even_tmult_time ; auto.
    rewrite tmult_time2_Sn.
    apply plus_le_compat ; auto.
    apply le_plus_trans.
    apply IND.
    apply lt_div2.
    apply lt_0_Sn.
    intros.
    rewrite odd_tmult_time.
    rewrite tmult_time2_Sn.
    apply plus_le_compat ; auto. apply plus_le_compat ; auto. auto.
  Qed.

Lemma n_le_n2 : forall n, n <= n*n.
Proof.
  intros.
  destruct n; auto.
  rewrite <- mult_1_l at 1.
  apply mult_le_compat_r.
  omega.
Qed.

Program Fixpoint tmult_time3 (n:nat) (m:nat) {measure n} :=
  match n with
    |0 => 1
    |S _ =>
     (tmult_time3 (div2 n) m) +
     2*cl_log m + 2*cl_log (double((div2 n)*m)) + 4
  end.

Lemma tmult_time3_Sn : forall n m, tmult_time3 (S n) m =
                                   (tmult_time3 (div2 (S n)) m) +
                                   2*cl_log m + 2*cl_log (double((div2 (S n))*m)) + 4.
Proof.
  intros.
  unfold tmult_time3. unfold tmult_time3_func.
  rewrite fix_sub_eq_ext.
  fold tmult_time3_func.
  simpl proj1_sig.
  unfold projT1.
  auto.
Qed.

Lemma tmult_time_2_3 : big_O2 tmult_time2 tmult_time3.
Proof.
  exists 0.
  exists 1.
  intros n m _ _.
  rewrite mult_1_l.
  apply (well_founded_ind
           lt_wf
           (fun n => forall m, tmult_time2 n m <= tmult_time3 n m)).
  clear n m.
  intros n Ind m.
  destruct n.
  auto.
  rewrite tmult_time2_Sn.
  rewrite tmult_time3_Sn.
  rewrite <- plus_assoc.
  rewrite <- plus_assoc.
  rewrite <- plus_assoc.
  apply plus_le_compat.
  apply Ind.
  apply lt_div2.
  omega.
  eapply le_trans.
  apply plus_le_compat.
  apply plus_cin_time_log.
  apply le_refl.
  omega.
Qed.

Lemma double_div2_prod : forall n m, double((div2 n)*m) <= n*m.
Proof.
  intros.
  destruct (even_odd_dec n).
  rewrite <- even_div_product; auto.
  assert (Even.even (n*m)).
  apply even_mult_l; auto.
  rewrite <- even_double.
  apply le_refl.
  auto.
  replace n with (S (double (div2 n))) at 2.
  unfold double.
  remember (div2 n) as N.
  replace (S (N+N)) with (N+N+1);[|omega].
  repeat rewrite mult_plus_distr_r.
  remember (N*m) as L.
  omega.
  apply eq_sym.
  apply odd_double.
  auto.
Qed.

Program Fixpoint tmult_time4 (n:nat) (m:nat) {measure n} :=
  match n with
    |0 => 1
    |S _ =>
     (tmult_time4 (div2 n) m) +
     2*cl_log m + 2*cl_log (n*m) + 4
  end.

Lemma tmult_time4_Sn : forall n m, tmult_time4 (S n) m =
                                   (tmult_time4 (div2 (S n)) m) +
                                   2*cl_log m + 2*cl_log ((S n)*m) + 4.
Proof.
  intros.
  unfold tmult_time4. unfold tmult_time4_func.
  rewrite fix_sub_eq_ext.
  fold tmult_time4_func.
  simpl proj1_sig.
  unfold projT1.
  auto.
Qed.

Lemma tmult_time_3_4 : big_O2 tmult_time3 tmult_time4.
Proof.
exists 0.
exists 1.
intros.
rewrite mult_1_l.
apply (well_founded_ind
           lt_wf
           (fun n => forall m, tmult_time3 n m <= tmult_time4 n m)).
clear.
intros.
destruct x.
auto.
rewrite tmult_time3_Sn.
rewrite tmult_time4_Sn.
apply plus_le_compat; auto.
repeat rewrite <- plus_assoc.
apply plus_le_compat.
auto.
apply plus_le_compat;auto.
apply mult_le_compat; auto.
apply cl_log_monotone.
apply double_div2_prod.
Qed.

Program Fixpoint tmult_time5 (n:nat) (m:nat) {measure n} :=
  match n with
    |0 => 1
    |S _ =>
     (tmult_time5 (div2 n) m) +
     2*cl_log m + 4*cl_log n + 4*cl_log m +4
  end.

Lemma tmult_time5_Sn : forall n m, tmult_time5 (S n) m =
                                   (tmult_time5 (div2 (S n)) m) +
                                   2*cl_log m + 4*cl_log (S n) + 4*cl_log m +4.
Proof.
  intros.
  unfold tmult_time5. unfold tmult_time5_func.
  rewrite fix_sub_eq_ext.
  fold tmult_time5_func.
  simpl proj1_sig.
  unfold projT1.
  auto.
Qed.

Lemma tmult_time_4_5 : big_O2 tmult_time4 tmult_time5.
Proof.
exists 0.
exists 1.
intros.
rewrite mult_1_l.
apply (well_founded_ind
           lt_wf
           (fun n => forall m, tmult_time4 n m <= tmult_time5 n m)).
clear.
intros.
destruct x.
auto.
rewrite tmult_time4_Sn.
rewrite tmult_time5_Sn.
apply plus_le_compat; auto.
repeat rewrite <- plus_assoc.
apply plus_le_compat.
auto.
apply plus_le_compat.
auto.
eapply le_trans.
apply mult_le_compat_l.
apply cl_log_product.
omega.
Qed.

Program Fixpoint tmult_time6 (n:nat) (m:nat) {measure n} :=
  match n with
    |0 => 1
    |S _ =>
     (tmult_time6 (div2 n) m) +
     8*cl_log m + 8*cl_log n
  end.

Lemma tmult_time6_Sn : forall n m, tmult_time6 (S n) m =
                                   (tmult_time6 (div2 (S n)) m) +
                                   8*cl_log m + 8*cl_log (S n).
Proof.
  intros.
  unfold tmult_time6. unfold tmult_time6_func.
  rewrite fix_sub_eq_ext.
  fold tmult_time6_func.
  simpl proj1_sig.
  unfold projT1.
  auto.
Qed.

Lemma tmult_time_5_6 : big_O2 tmult_time5 tmult_time6.
Proof.
exists 0.
exists 1.
intros.
rewrite mult_1_l.
apply (well_founded_ind
           lt_wf
           (fun n => forall m, tmult_time5 n m <= tmult_time6 n m)).
clear.
intros.
destruct x.
auto.
rewrite tmult_time5_Sn.
rewrite tmult_time6_Sn.
repeat rewrite <- plus_assoc.
apply plus_le_compat.
auto.
replace (2 * cl_log m + (4 * cl_log (S x) + (4 * cl_log m + 4)))
        with ((6 * cl_log m + 4 * cl_log (S x)) + 4);[|omega].
rewrite <- plus_assoc.
apply plus_le_compat.
omega.
replace (8 * cl_log (S x)) with (4 * cl_log (S x) + 4 * cl_log (S x));[|omega].
apply plus_le_compat; auto.
apply (le_trans (4*cl_log 1) (4*cl_log (S x)));auto.
apply mult_le_compat;auto.
apply cl_log_monotone.
omega.
Qed.

Theorem log_prod_big_oh :
  forall (k:nat) (f g : nat -> nat),
    monotone g ->
    f 0 = k /\ (forall n, f (S n) = f (div2 (S n)) + g (S n)) ->
    (exists m, 1 <= g m) ->
    big_oh f (fun n => (cl_log n) * (g n)).
Proof.
  intros.
  destruct H0.
  destruct H1.
  exists (max x 1).
  exists (max (k+1) 2).
  intros.
  eapply le_trans.
  apply log_prod_time.
  apply H.
  split.
  apply H0.
  apply H2.
  replace (k+1) with (S k);[|omega].
  replace 2 with (S 1);[|omega].
  rewrite <- succ_max_distr.
  replace (S (max k 1)) with (1 + (max k 1));[|omega].
  rewrite mult_plus_distr_r.
  rewrite mult_1_l.
  apply plus_le_compat; auto.
  assert (1 <= n).
  eapply le_trans.
  apply le_max_r.
  apply H3.
  eapply le_trans.
  assert (k <= k*((cl_log 1)*(g x))).
  unfold_sub cl_log (cl_log 1).
  rewrite cl_log_zero.
  rewrite mult_1_l.
  replace k with (k*1) at 1; try omega.
  apply mult_le_compat; auto.
  apply H5.
  apply mult_le_compat.
  apply le_max_l.
  apply mult_le_compat.
  apply cl_log_monotone; auto.
  apply H.
  apply max_lub_l with 1. auto.
Qed.

Theorem log_prod_big_O2 :
  forall (k:nat) (f g : nat -> nat -> nat),
    (forall m, monotone (fun n => g n m)) ->
    (forall m, f 0 m = k) /\ (forall n m, f (S n) m = f (div2 (S n)) m + g (S n) m) ->
    (exists l, forall m, 1 <= g l m) ->
    big_O2 f (fun n m => (cl_log n) * (g n m)).
Proof.
  intros.
  destruct H0.
  destruct H1.
  exists (max x 1).
  exists (max (k+1) 2).
  intros.
  eapply le_trans.
  apply log_prod_time2.
  apply H.
  split.
  apply H0.
  apply H2.
  replace (k+1) with (S k);[|omega].
  rewrite <- succ_max_distr.
  replace (S (max k 1)) with (1 + (max k 1));[|omega].
  rewrite mult_plus_distr_r.
  rewrite mult_1_l.
  apply plus_le_compat; auto.
  assert (1 <= n).
  eapply le_trans.
  apply le_max_r.
  apply H3.
  eapply le_trans.
  assert (k <= k*((cl_log 1)*(g x m))).
  unfold_sub cl_log (cl_log 1).
  rewrite cl_log_zero.
  rewrite mult_1_l.
  replace k with (k*1) at 1; try omega.
  apply mult_le_compat; auto.
  apply H6.
  apply mult_le_compat.
  apply le_max_l.
  apply mult_le_compat.
  apply cl_log_monotone; auto.
  apply H.
  apply max_lub_l with 1. auto.
Qed.

Theorem tmult_time_6_log_prod8 :
  big_O2 tmult_time6 (fun n m => (cl_log n) * (8*cl_log m + 8*cl_log n)).
Proof.
  intros.
  eapply log_prod_big_O2.
  unfold monotone.
  intros.
  apply plus_le_compat;auto;apply mult_le_compat;auto;apply cl_log_monotone;auto.
  split.
  compute.
  reflexivity.
  intros.
  rewrite plus_assoc.
  apply tmult_time6_Sn.
  exists 1.
  unfold_sub cl_log (cl_log 1).
  rewrite cl_log_zero.
  intros.
  omega.
Qed.

Theorem tmult_time_6_log_prod :
  big_O2 tmult_time6 (fun n m=> (cl_log n) * (cl_log m + cl_log n)).
Proof.
  intros.
  eapply big_O2_trans.
  apply tmult_time_6_log_prod8.
  apply big_O2_mult.
  exists 0.
  exists 8.
  intros.
  omega.
Qed.

Theorem tmult_time_is_log_prods :
  big_O2 tmult_time (fun n m => (cl_log n) * (cl_log m + cl_log n)).
Proof.
  intros.
  eapply big_O2_trans.
  apply tmult_time_1_2.
  eapply big_O2_trans.
  apply tmult_time_2_3.
  eapply big_O2_trans.
  apply tmult_time_3_4.
  eapply big_O2_trans.
  apply tmult_time_4_5.
  eapply big_O2_trans.
  apply tmult_time_5_6.
  apply tmult_time_6_log_prod.
Qed.


Require Import HoTT.
Require Import Definitions.

Section RightExactessHom.

  Context (G : graph).

  (*
    given a diagram [D] and a type [A] we construct the diagram [hom(D,A)]
  *)
  Definition representable_apply_diag
             (D : diagram G) (A : Type)
             : diagram (reverse_graph G).
  Proof.
    pose (cg_diag_0 (i: reverse_graph G) := D i -> A).
    exists cg_diag_0.
    intros i j f.
    exact (fun g => g o ((diagram1 D) j i f)).
  Defined.

  (*
    given a cocone [X] over [D] and a type [A] we get a cone [hom(X,A)]
    over [hom(D,A)].
    For this we need funext (right?).
  *)
  Definition representable_apply_cone `{Funext}
             {D : diagram G} (C : Type) (c : graph_cocone D C) (A : Type)
             : graph_cone (representable_apply_diag D A) (C -> A).
  Proof.
    exists (fun i h => h o (graph_cocone_pr1 c i)).
    intros. intro x.
    refine (path_arrow _ _ _).
    intro. simpl.
    pose (happ := (graph_cocone_pr2 c f)).
    exact (ap x (happ x0)).
  Defined.

  (*
    Given a diagram [D] and two types [L] and [A],
    there is an equivalence  [(L -> CoCone(D,A)) ~ Cone(hom(D,A),L)]
    given by the following map
  *)
  Definition coconetocone `{Funext}
             (D : diagram G) (A L : Type)
             : (L -> graph_cocone D A) ->
                 graph_cone (representable_apply_diag D A) L.
  Proof.
    intro.
    exists (fun i l => graph_cocone_pr1 (X l) i).
    intros. intro l.
    refine (path_arrow _ _ _).
    exact (graph_cocone_pr2 (X l) f).
  Defined.

  (* we can go back *)
  Definition conetococone
             (D : diagram G) (A L : Type)
             : graph_cone (representable_apply_diag D A) L ->
                 (L -> graph_cocone D A).
  Proof.
    intros X l.
    exists (fun i => graph_cone_pr1 X i l).
    intros.
    exact (happly (graph_cone_pr2 X f l)).
  Defined.

  (* and this is an equivalence *)
  Definition isEquiv_conetococone `{Funext}
             (D : diagram G) (A L : Type)
             : IsEquiv (conetococone D A L).
  Proof.
    refine (isequiv_adjointify (conetococone D A L)
                               (coconetocone D A L) _ _).
      - intro.
        refine (path_arrow _ _ _).
        intro l.
        simple refine (path_sigma _ _ _ _ _).
          + reflexivity.
          + do 3 (refine (path_forall _ _ _) ; intro).
            refine (path_forall _ _ _).
            exact (ap10_path_arrow _ _ _).
      - intro.
        simple refine (path_sigma _ _ _ _ _).
          + reflexivity.
          + refine (path_forall _ _ _).
            do 3 (intro ; refine (path_forall _ _ _)).
            intro. exact (eta_path_forall _ _ _).
  Defined.

  (* this is "the same" proof as above *)
  Definition isEquiv_coconetocone `{Funext}
             (D : diagram G) (A L : Type)
             : IsEquiv (coconetocone D A L).
  Proof.
    refine (isequiv_adjointify (coconetocone D A L)
                               (conetococone D A L) _ _).
      - intro.
        simple refine (path_sigma _ _ _ _ _).
          + reflexivity.
          + do 4 (refine (path_forall _ _ _) ; intro).
            exact (eta_path_forall _ _ _).
      - intro.
        refine (path_arrow _ _ _).
        intro l.
        simple refine (path_sigma _ _ _ _ _).
          + reflexivity.
          + refine (path_forall _ _ _).
            do 3 (intro ; refine (path_forall _ _ _)).
            exact (ap10_path_arrow _ _ _).
  Defined.

  (*
    by post composition with the cocone of [C] we have a map
    [(L -> hom(C,A)) -> (L -> CoCone(D,A))]
  *)
  Definition postcompose_with_cocone
             {D : diagram G} {C : Type} (c : graph_cocone D C) (A L : Type)
             : (L -> C -> A) -> (L -> graph_cocone D A)
  := fun f => (map_to_graph_cocone c A) o f.

  (* and if [C] is a colimit, then this is an equivalence *)
  Definition isEquiv_postcompose_with_cocone `{Funext}
             {D : diagram G} {C : Type} {c : graph_cocone D C}
             (lc : is_colimit_cocone c) (A L : Type)
             : IsEquiv (postcompose_with_cocone c A L).
  Proof.
    pose (the_equivalence := lc A).
    exact (isequiv_postcompose (map_to_graph_cocone c A)).
  Defined.

  (*
    [map_to_graph_cone] factors through the equivalence [conetococone]
  *)
  Definition map_to_graph_cone_factors_conetococone `{Funext}
             {D : diagram G} {C : Type}
             (c : graph_cocone D C) (A : Type) (L : Type)
             : (coconetocone D A L) o (postcompose_with_cocone c A L) =
                 (map_to_graph_cone (representable_apply_cone C c A) L).
  Proof.
    refine (path_arrow _ _ _).
    intro.
    simple refine (path_sigma _ _ _ _ _).
      - reflexivity.
      - do 3 (refine (path_forall _ _ _) ; intro).
        reflexivity.
  Defined.

  (*
    given a colimit cocone [X] over [D] and a type [A], we get a limit cone [hom(X,A)]
    over [hom(D,A)]. i.e. hom(-,A) maps colimits to limits
  *)
  Definition homisexact `{Funext}
             {D : diagram G} {C : Type}
             (c : graph_cocone D C) (cl : is_colimit_cocone c) (A : Type)
             : is_limit_cone (representable_apply_cone C c A).
  Proof.
    intro L.
    refine (isequiv_homotopic _ _).
      - pose (equiv1 := isEquiv_postcompose_with_cocone cl A L).
        pose (equiv2 := isEquiv_coconetocone D A L).
        exact (isequiv_compose' (postcompose_with_cocone c A L) equiv1
                                (coconetocone D A L) equiv2 ).
      - intro f.
        exact (happly (map_to_graph_cone_factors_conetococone c A L) f).
  Defined.

End RightExactessHom.


(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Unset Positivity Checking.
Unset Guard Checking.

Inductive nat : Set :=
| O : nat
| S : nat -> nat.

Inductive natural : Set :=
| Zero : natural
| Succ : natural -> natural.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) {struct plus_arg0}
  : natural :=
  match plus_arg0 with
  | Zero => plus_arg1
  | Succ n => Succ (plus n plus_arg1)
  end.

Definition synth (lf1 : natural) (y : natural) (lf2 : natural) : natural :=
  plus lf1 lf2.


Require Import Coq.ZArith.BinInt.
Require Import riscv.Encode.
Require Import riscv.util.ZBitOps.
Require Import riscv.util.prove_Zeq_bitwise.

Lemma invert_encode_I_system: forall {opcode rd rs1 funct3 funct12},
  verify_I_system opcode rd rs1 funct3 funct12 ->
  forall inst,
  encode_I_system opcode rd rs1 funct3 funct12 = inst ->
  opcode = bitSlice inst 0 7 /\
  funct3 = bitSlice inst 12 15 /\
  funct12 = bitSlice inst 20 32 /\
  rd = bitSlice inst 7 12 /\
  rs1 = bitSlice inst 15 20.
Proof. intros. unfold encode_I_system, verify_I_system in *. prove_Zeq_bitwise. Qed.


Require Export LaugwitzSchmieden.
Require Import HRw_spec.

Module LS2n <: Num_w.

Include LS.
(* Definitions in LS are available here thanks to the module type declaration for LS - see above - *)
Fixpoint power2 (n:nat) : Z :=
match n with
| O => 1%Z
| S p => (2 * (power2 p))%Z
end.

Lemma power2_pos : forall n:nat, (0 < power2 n)%Z.
Proof.
induction n.
unfold power2; omega.
change (0 < 2 * (power2 n))%Z.
omega.
Qed.

Lemma n_power : forall n, (Z_of_nat n < power2 n)%Z.
Proof.
induction n.
simpl; omega.
change (Z.of_nat (S n) < 2* power2 n)%Z.
setoid_replace (Z.of_nat (S n)) with ((Z.of_nat n)+1)%Z
  by (rewrite Nat2Z.inj_succ; unfold Z.succ; reflexivity).
omega.
Qed.

Definition w :A := fun (n:nat) => power2 n.

Lemma beta_w : leA beta w.
Proof.
unfold beta, w; unfold_intros.
exists 0%nat.
intros.
generalize (n_power n); intros; omega.
Qed.

Lemma Aw : 0 <A w.
Proof.
unfold ltA.
exists 0%nat.
intros; apply power2_pos.
Qed.

Lemma lim_lt_w : forall a, lim a/\ leA 0 a -> ltA a w.
intros.
apply lt_le_trans with beta.
apply lim_lt_beta.
assumption.
apply beta_w.
Qed.

Lemma div_modw2 : forall a, w*(a/w) =A a + - (a mod% w).
Proof.
intros.
apply div_mod2.
left; apply Aw.
Qed.

Lemma div_modw3 : forall a, |(a mod% w)| <A w.
Proof.
intros.
apply div_mod3.
apply Aw.
Qed.

Lemma  ANS3 : ~ lim w.
Proof.
intro H; unfold lim in *.
elim H; clear H; intros p (Hstdp,(Hle0p,Hwp)).
unfold ltA,a0 in *.
elim Hstdp.
intros b Hb.
elim Hwp.
intros a Ha.
elim Hle0p.
intros c Hc.
(* w (p (a+b+c+1) + a + b + c + 1) = p (a+b+c+1) + a+b+c+1 *)
(* p (p (a+b+c+1) + a + b + c + 1) = p (a + b + c + 1) because p(a+b+c+1)>=0 et Hb: p is std *)
pose (px:=p (a+b+c+1)%nat).
assert (0<= px)%Z.
apply Hc.
omega.
pose (x:=((Z.abs_nat px)+a+b+c+1)%nat).
assert ((|w |) (x) < p (x))%Z.
apply Ha.
unfold px,x in *.
omega.

assert  ((|w |) (x) >= p (x))%Z.
apply Z.le_ge.
apply Z.le_trans with  (((|fun n => Z_of_nat n|) (x))%Z).
unfold absA in *.
unfold w.
unfold x.
replace (p (Z.abs_nat px + a + b + c + 1)%nat)%Z with
(p (a+b+c+1)%nat)%Z.
rewrite Z.abs_eq.
replace (Z.abs_nat px + a + b + c + 1)%nat with (Z.abs_nat (px + (Z_of_nat (a + b + c + 1))))%nat.
rewrite inj_Zabs_nat.
rewrite Z.abs_eq.
unfold px.
omega.
omega.
rewrite Zabs_nat_Zplus.
rewrite Zabs_nat_Z_of_nat.
ring.
unfold px; apply Hc.
omega.
solve [auto with zarith].
solve [auto with zarith].
apply Hb.
omega.
omega.
unfold w, absA.
rewrite Z.abs_eq.
rewrite Z.abs_eq.
assert (Z.of_nat x < power2 x)%Z.
apply n_power.
omega.
generalize (power2_pos x); intros; omega.
apply Zle_0_nat.
omega.
Qed.

Lemma power2_increases_step : forall m:nat, (power2 m <= power2 (S m))%Z.
Proof.
induction m.
simpl; omega.
replace (power2 (S (S m))) with (2*((power2 (S m))))%Z by trivial.
replace (power2 (S m)) with (2*power2 m)%Z by trivial.
apply Z.mul_le_mono_nonneg_l.
omega.
assumption.
Qed.

Lemma w_increases : forall n m:nat, (n <= m)%nat -> (w n <= w m)%Z.
Proof.
  induction 1.
apply Z.le_refl.
unfold w.
apply Z.le_trans with (power2 m).
assumption.
apply power2_increases_step.
Qed.

End LS2n.

(* axiom A2.3 does not hold : Lemma R2_3 : forall x y, ~HRwdiff x y -> HRwequal x y. *)
Module Export KK := mHRwspec(LS2n).

Definition u (n:nat) : Z :=
if (Nat.even n) then 0 else LS2n.w (Nat.div2 n).

Lemma u_positive : forall n:nat, (0 <= u n)%Z.
Proof.
  intros.
  unfold u; simpl.
  destruct (Nat.even n).
  omega.
  unfold LS2n.w.
  apply Z.lt_le_incl.
  apply LS2n.power2_pos.
Qed.

Lemma u_pos : LS2n.leA LS2n.a0 u.
Proof.
unfold LS2n.leA, LS2n.a0.
exists 0; intros.
apply u_positive.
Qed.

(* belongs to HRw *)

Lemma Pu : P u.
Proof.
  unfold P.
  exists (fun x => 1%Z).
  unfold LS2n.lim; split.
exists (fun x => 2%Z).
split.
unfold LS2n.std; intros; exists 0%nat; reflexivity.
split.
unfold LS2n.leA, LS2n.a0.
exists 0%nat.
intros;omega.

unfold LS2n.ltA, LS2n.absA.
exists 0%nat; intros.
rewrite Z.abs_eq; omega.
split.
unfold LS2n.ltA, LS2n.a0.
exists 0; intros; omega.
unfold LS2n.leA, LS2n.absA, LS2n.multA.
exists 0; intros; rewrite Z.abs_eq.
ring_simplify.
unfold u; destruct (Nat.even n).
apply Z.lt_le_incl.
apply LS2n.power2_pos.
unfold LS2n.w.
Search LS2n.power2.
apply LS2n.w_increases.
Search Nat.div2.
apply Nat.div2_decr.
solve [auto].
apply u_positive.
Qed.

Definition HRw_u : HRw.
  exists u.
  apply Pu.
Defined.

(* not equal to 0 *)
Lemma HRwequal_u_0 : ~ HRwequal HRw_u HRw0.
Proof.
  unfold HRwequal, HRw_u, HRw0; (*unfold LS2n.lim, LS2n.leA, LS2n.multA, LS2n.absA, LS2n.plusA, LS2n.oppA, LS2n.a0, LS2n.w; *) intros; intro.
  pose (p k:=(Z.abs (Z.div (LS2n.w (2*k+1)%nat) (LS2n.w k))+1)%Z).

(*assert (LS2n.ltA LS2n.w (LS2n.multA p u) ).
unfold LS2n.ltA, LS2n.multA.
exists 1.
intros.
unfold u.
unfold p.
*)

assert (Hlim:LS2n.lim p).
admit.
assert (Hlt:LS2n.ltA LS2n.a0 p).
admit.
assert (HA:LS2n.leA (LS2n.multA p (LS2n.absA (LS2n.plusA u (LS2n.oppA LS2n.a0)))) LS2n.w).
apply (H p Hlim Hlt).

apply (LS2n.le_lt_False (LS2n.multA p u) LS2n.w).

assert (L1:LS2n.equalA (LS2n.plusA u (LS2n.oppA LS2n.a0)) u).
assert (L2:LS2n.equalA (LS2n.oppA LS2n.a0) LS2n.a0).
rewrite <- LS2n.plus_neutral.
apply LS2n.plus_opp.
rewrite L2.
rewrite LS2n.plus_comm.
rewrite LS2n.plus_neutral.
reflexivity.
rewrite LS2n.abs_pos_val in HA.
rewrite L1 in HA.
assumption.
rewrite L1.
apply u_pos.

Admitted.
(*Lemma x : LS2n.oppA LS2n.a0 = LS2n.a0.
Proof.
unfold LS2n.oppA, LS2n.a0.
Admitted.
*)
(* not distinct from 0 *)
Lemma HRwdiff_u_0 : ~ HRwdiff HRw_u HRw0.
Proof.
  unfold HRwdiff, HRw_u, HRw0; intros; intro Hex.
  destruct Hex.
Admitted.

Lemma contradiction : (forall x y, ~HRwdiff x y -> HRwequal x y) -> False.
Proof.
intros.
generalize (H HRw_u HRw0); intros Hsp.
apply HRwequal_u_0.
apply Hsp.
apply HRwdiff_u_0.
Qed.