From Hammer Require Import Hammer.

From WeakUpTo Require Export Settings.
From WeakUpTo Require Import Theory.
Set Implicit Arguments.

Section Modular.

Variables A X: Type.
Variable TX: reduction_t A X.

Let F  := Comp (chaining_l (expand TX TX)) (chaining_r (bisim TX TX)).
Let G  := Comp (star (X:=X)) (Union2 (identity (X:=X) (Y:=X)) (constant (bisim TX TX))).

Lemma F_mon: monotonic TX TX F.
Proof. hammer_hook "Applications" "Applications.F_mon".
unfold F; apply Comp_mon.
apply chaining_r_mon.
apply (proj1 (bisimulation_bisim TX TX)).
apply chaining_l_mon.
apply (proj1 (expansion_expand TX TX)).
Qed.
Lemma G_wmon: wmonotonic TX TX G.
Proof. hammer_hook "Applications" "Applications.G_wmon".
unfold G; apply Comp_wmon.
apply Union2_wmon.
apply monotonic_wmonotonic; apply identity_mon.
apply monotonic_wmonotonic; apply constant_mon.
apply (proj1 (bisimulation_bisim TX TX)).
apply star_wmon.
Qed.

Lemma FG: contains F G.
Proof. hammer_hook "Applications" "Applications.FG".
intros R x y XY; destruct XY as [ x' XX' X'Y ]; destruct X'Y as [ y' X'Y' Y'Y ].
unfold G, Comp, Union2; simpl; apply S_star with x'; auto.
right; unfold constant; apply wexpand_bisim; apply expand_wexpand; auto.
apply S_star with y'.
left; auto.
apply star1; right; auto.
Qed.

Lemma G_reverse: forall R, eeq (trans (G R)) (G (trans R)).
intros R; unfold G, Comp, Union2, identity, constant.
eapply eeq_trans; [ apply inv_star | apply star_eeq ].
eapply eeq_trans; [ apply inv_union2 | apply union2_eeq; auto ].
split; intros x y H; apply (bisim_sym H).
Qed.

Variable R: relation X.
Hypothesis HRt: evolve_t TX TX R (F R).
Hypothesis HRa: evolve_a TX TX R (G R).
Hypothesis HRt': evolve_t TX TX (trans R) (F (trans R)).
Hypothesis HRa': evolve_a TX TX (trans R) (G (trans R)).

Theorem upto: incl R (bisim TX TX).
Proof. hammer_hook "Applications" "Applications.upto".
intros x y H; exists (UIter (UIter G) R).
split.
apply unified_correct with F; auto.
exact F_mon.
exact G_wmon.
exact FG.
apply simulation_eeq with (UIter (UIter G) (trans R)).
apply eeq_sym; repeat apply UIter_trans; repeat apply UIter_inc; try apply (wmon_m G_wmon).
apply G_reverse.
apply unified_correct with F; auto.
exact F_mon.
exact G_wmon.
exact FG.
exists 0; exact H.
Qed.

End Modular.

Section Controlled.

Variables A X: Type.
Variable TX: reduction_t A X.

Variables B B': relation X.
Hypothesis HB: bicontrolled TX B.
Hypothesis HB': bicontrolled TX B'.

Let F  := chaining_r (X:=X) (bisim TX TX).
Let G  := Comp (star (X:=X)) (Union2 (identity (X:=X) (Y:=X)) (constant (bisim TX TX))).

Let F_mon: monotonic TX TX F.
Proof. hammer_hook "Applications" "Applications.Controlled.F_mon".
unfold F; apply chaining_r_mon; apply (proj1 (bisimulation_bisim TX TX)).
Qed.

Let FG: contains F G.
Proof. hammer_hook "Applications" "Applications.Controlled.FG".
intros R x y XY; destruct XY as [ w XW WY ].
unfold G, Comp, Union2; simpl; apply S_star with w; auto.
left; auto.
apply star1; right; auto.
Qed.

Let BG: contains (chaining_l (star B)) G.
Proof. hammer_hook "Applications" "Applications.Controlled.BG".
intros R x y XY; destruct XY as [ w XW WY ].
unfold G, Comp, Union2, constant; simpl; apply S_star with w; auto.
right; induction XW as [ w | z x w ZX XW  IH ].
apply bisim_refl.
apply bisim_trans with z; auto.
apply (proj2 HB _ _ ZX).
apply star1; left; auto.
Qed.

Let B'G: contains (chaining_l (star B')) G.
Proof. hammer_hook "Applications" "Applications.Controlled.B'G".
intros R x y XY; destruct XY as [ w XW WY ].
unfold G, Comp, Union2, constant; simpl; apply S_star with w; auto.
right; induction XW as [ w | z x w ZX XW  IH ].
apply bisim_refl.
apply bisim_trans with z; auto.
apply (proj2 HB' _ _ ZX).
apply star1; left; auto.
Qed.

Variable R: relation X.
Hypothesis HRt: evolve_t TX TX R (comp (star B) (F R)).
Hypothesis HRa: evolve_a TX TX R (G R).
Hypothesis HRt': evolve_t TX TX (trans R) (comp (star B') (F (trans R))).
Hypothesis HRa': evolve_a TX TX (trans R) (G (trans R)).

Theorem upto_ctrl: incl R (bisim TX TX).
Proof. hammer_hook "Applications" "Applications.upto_ctrl".
intros x y H; exists (UIter (UIter G) R).
split.
apply controlled_correct with B F; auto.
exact (proj1 HB).
unfold G; apply G_wmon.
unfold transparent, F, chaining_r; intro U;
apply (proj1 (comp_assoc (star B) U (bisim TX TX))).
apply simulation_eeq with (UIter (UIter G) (trans R)).
unfold G; apply eeq_sym; repeat apply UIter_trans; repeat apply UIter_inc; try apply (wmon_m (G_wmon TX)).
apply G_reverse.
apply controlled_correct with B' F; auto.
exact (proj1 HB').
unfold G; apply G_wmon.
unfold transparent, F, chaining_r; intro U;
apply (proj1 (comp_assoc (star B') U (bisim TX TX))).
exists 0; exact H.
Qed.

End Controlled.


Require Import Crypto.Compilers.Syntax.
Require Import Crypto.Compilers.ExprInversion.
Require Import Crypto.Compilers.SmartMap.

Section language.
  Context {base_type_code} {op : flat_type base_type_code -> flat_type base_type_code -> Type}.

  Section generic_type.
    Context {A}
            (process : base_type_code -> A)
            (fold : A -> A -> A).

    Section with_var.
      Context {var : base_type_code -> Type}
              (init : A)
              (dummy : forall t, var t).

      Fixpoint fold_flat_type (t : flat_type base_type_code) : A
        := match t with
           | Tbase T => process T
           | Unit => init
           | Prod A B => fold (fold_flat_type A) (fold_flat_type B)
           end.

      Fixpoint type_foldf {t} (e : @exprf base_type_code op var t) : A
        := match e with
           | TT => init
           | Var t v => process t
           | Op t tR opc args
             => fold (@type_foldf t args) (fold_flat_type tR)
           | LetIn tx ex tC eC
             => fold (@type_foldf tx ex)
                     (@type_foldf tC (eC (SmartValf _ dummy _)))
           | Pair tx ex ty ey
             => fold (@type_foldf tx ex) (@type_foldf ty ey)
           end.

      Definition type_fold {t} (e : @expr base_type_code op var t) : A
        := fold (fold_flat_type (domain t)) (type_foldf (invert_Abs e (SmartValf _ dummy _))).
    End with_var.

    Definition TypeFold (init : A) {t} (e : Expr base_type_code op t) : A
      := type_fold init (fun _ => tt) (e (fun _ => unit)).
  End generic_type.
End language.


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.solinas32_2e322m2e161m1_14limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition mul :
  { mul : feBW_loose -> feBW_loose -> feBW_tight
  | forall a b, phiBW_tight (mul a b) = F.mul (phiBW_loose a) (phiBW_loose b) }.
Proof.
  Set Ltac Profiling.
  Time synthesize_mul ().
  Show Ltac Profile.
Time Defined.

Print Assumptions mul.


(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)

(* Different definitions of pathes in a graph, directed or not.         *)

(* The following notions are defined :                                  *)
(*      - Walk : defined by 2 ends,                                     *)
(*                      a list of vertices and a list of edges          *)
(*              constructors : W_null, W_step;                          *)
(*      - Trail : walk without repetition of edge,                      *)
(*              constructors : T_null, T_step;                          *)
(*      - Path : trail without repetition of inner vertex,              *)
(*              constructors : P_null, P_step;                          *)
(*      - Closed_walk, Closed_trail, Cycle.                             *)

Require Export Graphs.
Require Export Degrees.

Section PATH.

Variable v : V_set.
Variable a : A_set.

Inductive Walk : Vertex -> Vertex -> V_list -> E_list -> Set :=
  | W_null : forall x : Vertex, v x -> Walk x x V_nil E_nil
  | W_step :
      forall (x y z : Vertex) (vl : V_list) (el : E_list),
      Walk y z vl el ->
      v x -> a (A_ends x y) -> Walk x z (y :: vl) (E_ends x y :: el).

Definition Closed_walk (x y : Vertex) (vl : V_list)
  (el : E_list) (w : Walk x y vl el) := x = y.

Inductive Trail : Vertex -> Vertex -> V_list -> E_list -> Set :=
  | T_null : forall x : Vertex, v x -> Trail x x V_nil E_nil
  | T_step :
      forall (x y z : Vertex) (vl : V_list) (el : E_list),
      Trail y z vl el ->
      v x ->
      a (A_ends x y) ->
      (forall u : Edge, In u el -> ~ E_eq u (E_ends x y)) ->
      Trail x z (y :: vl) (E_ends x y :: el).

Definition Closed_trail (x y : Vertex) (vl : V_list)
  (el : E_list) (t : Trail x y vl el) := x = y.

Inductive Path : Vertex -> Vertex -> V_list -> E_list -> Set :=
  | P_null : forall x : Vertex, v x -> Path x x V_nil E_nil
  | P_step :
      forall (x y z : Vertex) (vl : V_list) (el : E_list),
      Path y z vl el ->
      v x ->
      a (A_ends x y) ->
      x <> y ->
      ~ In y vl ->
      (In x vl -> x = z) ->
      (forall u : Edge, In u el -> ~ E_eq u (E_ends x y)) ->
      Path x z (y :: vl) (E_ends x y :: el).

Definition Cycle (x y : Vertex) (vl : V_list) (el : E_list)
  (p : Path x y vl el) := x = y.

Lemma P_iny_vl :
 forall (x y : Vertex) (vl : V_list) (el : E_list),
 Path x y vl el -> vl <> V_nil -> In y vl.
Proof.
        intros x y vl el p; elim p; intros.
        absurd (V_nil = V_nil); auto.

        inversion p0.
        simpl in |- *; auto.

        rewrite H10; simpl in |- *; right.
        apply H; rewrite <- H10; discriminate.
Qed.

Lemma P_endx_inv :
 forall (x y : Vertex) (vl : V_list) (el : E_list), Path x y vl el -> v x.
Proof.
        intros x y vl el p; elim p; auto.
Qed.

Lemma P_endy_inv :
 forall (x y : Vertex) (vl : V_list) (el : E_list), Path x y vl el -> v y.
Proof.
        intros x y vl el p; elim p; auto.
Qed.

Lemma P_invl_inv :
 forall (x y : Vertex) (vl : V_list) (el : E_list),
 Path x y vl el -> forall z : Vertex, In z vl -> v z.
Proof.
        intros x y vl el p; elim p; intros.
        inversion H.

        inversion H0.
        rewrite <- H1; apply (P_endx_inv _ _ _ _ p0).

        auto.
Qed.

Lemma P_inel_ina :
 forall (x y : Vertex) (vl : V_list) (el : E_list),
 Path x y vl el ->
 forall x' y' : Vertex, In (E_ends x' y') el -> a (A_ends x' y').
Proof.
        intros x y vl el p; elim p; intros.
        inversion H.

        inversion H0.
        inversion H1.
        rewrite <- H3; rewrite <- H4; trivial.

        auto.
Qed.

Lemma P_inxyel_inxvl :
 forall (x y : Vertex) (vl : V_list) (el : E_list),
 Path x y vl el ->
 forall x' y' : Vertex, In (E_ends x' y') el -> In x' (x :: vl).
Proof.
        intros x y vl el p; elim p; intros.
        inversion H.

        inversion H0.
        inversion H1.
        simpl in |- *; auto.

        simpl in |- *; right.
        apply (H x' y'); auto.
Qed.

Lemma P_inxyel_inyvl :
 forall (x y : Vertex) (vl : V_list) (el : E_list),
 Path x y vl el ->
 forall x' y' : Vertex, In (E_ends x' y') el -> In y' (x :: vl).
Proof.
        intros x y vl el p; elim p; intros.
        inversion H.

        inversion H0.
        inversion H1.
        simpl in |- *; auto.

        simpl in |- *; right.
        apply (H x' y'); auto.
Qed.

Lemma P_backstep :
 forall (x y z : Vertex) (vl : V_list) (el : E_list),
 Path x z (y :: vl) el -> {el' : E_list &  Path y z vl el'}.
Proof.
        intros; inversion H.
        split with el0; trivial.
Qed.

Lemma Trail_isa_walk :
 forall (x y : Vertex) (vl : V_list) (el : E_list),
 Trail x y vl el -> Walk x y vl el.
Proof.
        intros x y vl el t; elim t; intros.
        apply W_null; trivial.

        apply W_step; trivial.
Qed.

Lemma Path_isa_trail :
 forall (x y : Vertex) (vl : V_list) (el : E_list),
 Path x y vl el -> Trail x y vl el.
Proof.
        intros x y vl el t; elim t; intros.
        apply T_null; trivial.

        apply T_step; trivial.
Qed.

End PATH.

Section EXTRACTED.

Variable v : V_set.
Variable a : A_set.

Fixpoint V_extract (x : Vertex) (vl : V_list) {struct vl} : V_list :=
  match vl with
  | nil => V_nil
  | y :: vl' =>
      if V_in_dec x vl' then V_extract x vl' else vl'
  end.

Lemma P_extract :
 forall (x y z : Vertex) (vl : V_list) (el : E_list),
 Path v a y z vl el ->
 In x (y :: vl) -> {el' : E_list &  Path v a x z (V_extract x (y :: vl)) el'}.
Proof.
        intros x y z vl; generalize y; elim vl; simpl in |- *; intros.
        split with el.
        replace x with y0; auto.
        case (V_in_dec y0 nil); auto.

        tauto.

        elim (P_backstep _ _ _ _ _ _ _ H0); intros.
        case (V_in_dec x (a0 :: l)). intros.
        apply (H a0 x0); auto.

        simpl in |- *. intros. split with el. replace x with y0.
        trivial.

        tauto.
Qed.

Remark P_when_cycle :
 forall (x y : Vertex) (vl : V_list) (el : E_list),
 Path v a x y vl el -> In x vl -> x = y.
Proof.
        intros x y vl el H; inversion H; intros.
        trivial.

        inversion H11.
        absurd (x = y0); auto.

        auto.
Qed.

Lemma Walk_to_path :
 forall (x y : Vertex) (vl : V_list) (el : E_list),
 Walk v a x y vl el ->
 {vl0 : V_list &  {el0 : E_list &  Path v a x y vl0 el0}}.
Proof.
        intros x y vl el w; elim w; intros.
        split with V_nil; split with E_nil; apply P_null; trivial.

        elim H; clear H; intros vl' H.
        elim H; clear H; intros el' H.
        case (V_in_dec x0 (y0 :: vl')); intros.
        elim (P_extract _ _ _ _ _ H i); intros.
        split with (V_extract x0 (y0 :: vl')); split with x1; auto.

        case (V_in_dec y0 vl'); intros.
        split with (y0 :: V_nil); split with (E_ends x0 y0 :: E_nil). apply P_step.
        replace z with y0.
        apply P_null; apply (P_endx_inv _ _ _ _ _ _ H).

        apply (P_when_cycle _ _ _ _ H); auto.

        trivial.

        trivial.

        red in |- *; intros; elim n; rewrite H0; simpl in |- *; auto.

        tauto.

	simpl in |- *. tauto.

        tauto.

        split with (y0 :: vl'); split with (E_ends x0 y0 :: el').
        apply P_step.
        trivial.

        trivial.

        trivial.

        red in |- *; intros; elim n; rewrite H0; simpl in |- *; auto.

        trivial.

        intros; absurd (In x0 vl').
        red in |- *; intros; elim n; simpl in |- *; auto.

        trivial.

        red in |- *; intros.
        elim n; inversion H1.
        apply (P_inxyel_inxvl _ _ _ _ _ _ H x0 y0).
        rewrite <- H3; auto.

        apply (P_inxyel_inyvl _ _ _ _ _ _ H y0 x0).
        rewrite <- H4; rewrite <- H5; rewrite H2; trivial.
Qed.

End EXTRACTED.

Section PATH_AND_DEGREE.

Variable v : V_set.
Variable a : A_set.
Variable g : Graph v a.

Lemma Path_degree_one :
 forall (x y : Vertex) (vl : V_list) (el : E_list),
 Path v a x y vl el -> forall z : Vertex, In z vl -> degree z v a g > 0.
Proof.
        intros x y vl el p; elim p; intros.
        inversion H.

        inversion H0.
        rewrite <- H1; apply Degree_not_isolated.
        split with x0; apply (G_non_directed v a g); trivial.

        apply H; auto.
Qed.

Lemma Path_consx_degree_one :
 forall (x y : Vertex) (vl : V_list) (el : E_list),
 Path v a x y vl el ->
 vl <> V_nil -> forall z : Vertex, In z (x :: vl) -> degree z v a g > 0.
Proof.
        simple destruct vl; intros.
        absurd (nil = V_nil); auto.

        inversion H1.
        rewrite <- H2; apply Degree_not_isolated.
        inversion H; split with v0; trivial.

        apply (Path_degree_one x y (v0 :: l) el H); auto.
Qed.

Lemma Path_degree_two :
 forall (x y : Vertex) (vl : V_list) (el : E_list),
 Path v a x y vl el ->
 forall z : Vertex, In z vl -> z <> y -> degree z v a g > 1.
Proof.
        intros x y vl el p; elim p; intros.
        inversion H.

        inversion H0.
        inversion p0.
        absurd (z0 = z).
        trivial.

        rewrite <- H2; auto.

        rewrite <- H2; apply Degree_not_pendant.
        split with x0.
        apply (G_non_directed v a g); trivial.

        split with y1.
        trivial.

        red in |- *; intros.
        elim (n1 (E_ends y0 y1)).
        rewrite <- H13; simpl in |- *; auto.

        rewrite H14; apply E_rev.

        apply H; trivial.
Qed.

Lemma Path_last_step :
 forall (x y : Vertex) (vl : V_list) (el : E_list) (p : Path v a x y vl el),
 el <> E_nil -> exists z : Vertex, In (E_ends z y) el.
Proof.
        intros x y vl el p; elim p.
        intros; elim H; trivial.

        simple destruct el0; intros.
        split with x0.
        inversion p0.
        simpl in |- *; left; trivial.

        elim H; intros.
        split with x1.
        simpl in |- *; auto.

        discriminate.
Qed.

Lemma Cycle_degree_two :
 forall (x y : Vertex) (vl : V_list) (el : E_list) (p : Path v a x y vl el),
 Cycle v a x y vl el p -> forall z : Vertex, In z vl -> degree z v a g > 1.
Proof.
        intros; case (V_eq_dec z y); intros.
        rewrite e; apply Degree_not_pendant.
        inversion p.
        rewrite <- H4 in H0; inversion H0.

        inversion H.
        split with y0.
        rewrite <- H12; trivial.

        elim (Path_last_step y0 y vl0 el0 H1); intros.
        split with x1.
        apply (G_non_directed v a g); apply (P_inel_ina v a y0 y vl0 el0 H1);
         trivial.

        red in |- *; intros; elim (H7 (E_ends x1 y)).
        trivial.

        rewrite H12; rewrite H14; apply E_rev.

        inversion H1.
        absurd (x = y0).
        trivial.

        rewrite H15; trivial.

        discriminate.

        apply (Path_degree_two x y vl el p); trivial.
Qed.

Lemma Cycle_consx_degree_two :
 forall (x y : Vertex) (vl : V_list) (el : E_list) (p : Path v a x y vl el),
 vl <> V_nil ->
 Cycle v a x y vl el p ->
 forall z : Vertex, In z (x :: vl) -> degree z v a g > 1.
Proof.
        intros; inversion H1.
        rewrite <- H2; inversion H0.
        apply (Cycle_degree_two x y vl el p H0 y).
        apply (P_iny_vl v a x y vl el p); trivial.

        apply (Cycle_degree_two x y vl el p H0); trivial.
Qed.

Lemma Path_degree_zero_nil :
 forall (x y : Vertex) (vl : V_list) (el : E_list),
 Path v a x y vl el ->
 (exists2 z : Vertex, In z (x :: vl) & degree z v a g = 0) -> vl = V_nil.
Proof.
        simple destruct vl; intros.
        trivial.

        elim H0; intros.
        absurd (degree x0 v a g > 0).
        omega.

        apply (Path_consx_degree_one _ _ _ _ H).
        discriminate.

        trivial.
Qed.

Lemma Cycle_degree_one_nil :
 forall (x y : Vertex) (vl : V_list) (el : E_list) (p : Path v a x y vl el),
 Cycle v a x y vl el p ->
 (exists2 z : Vertex, In z (x :: vl) & degree z v a g <= 1) -> vl = V_nil.
Proof.
        simple destruct vl; intros.
        trivial.

        elim H0; intros.
        absurd (degree x0 v a g > 1).
        omega.

        apply (Cycle_consx_degree_two _ _ _ _ p).
        discriminate.

        trivial.

        trivial.
Qed.

End PATH_AND_DEGREE.

Section PATH_EQ.

Lemma Walk_eq :
 forall (v v' : V_set) (a a' : A_set) (x y : Vertex)
   (vl : V_list) (el : E_list),
 Walk v a x y vl el -> v = v' -> a = a' -> Walk v' a' x y vl el.
Proof.
        intros; elim H; intros.
        apply W_null.
        rewrite <- H0; trivial.

        apply W_step.
        trivial.

        rewrite <- H0; trivial.

        rewrite <- H1; trivial.
Qed.

Lemma Trail_eq :
 forall (v v' : V_set) (a a' : A_set) (x y : Vertex)
   (vl : V_list) (el : E_list),
 Trail v a x y vl el -> v = v' -> a = a' -> Trail v' a' x y vl el.
Proof.
        intros; elim H; intros.
        apply T_null.
        rewrite <- H0; trivial.

        intros; apply T_step.
        trivial.

        rewrite <- H0; trivial.

        rewrite <- H1; trivial.

        trivial.
Qed.

Lemma Path_eq :
 forall (v v' : V_set) (a a' : A_set) (x y : Vertex)
   (vl : V_list) (el : E_list),
 Path v a x y vl el -> v = v' -> a = a' -> Path v' a' x y vl el.
Proof.
        intros; elim H; intros.
        apply P_null.
        rewrite <- H0; trivial.

        intros; apply P_step.
        trivial.

        rewrite <- H0; trivial.

        rewrite <- H1; trivial.

        trivial.

        trivial.

        trivial.

        trivial.
Qed.

End PATH_EQ.

Section PATH_IN_A_SUBGRAPH.

Lemma Walk_subgraph :
 forall (v v' : V_set) (a a' : A_set) (x y : Vertex)
   (vl : V_list) (el : E_list),
 Walk v a x y vl el ->
 V_included v v' -> A_included a a' -> Walk v' a' x y vl el.
Proof.
        intros; elim H; intros.
        apply W_null; apply (H0 x0); trivial.

        apply W_step.
        trivial.

        apply (H0 x0); trivial.

        apply (H1 (A_ends x0 y0)); trivial.
Qed.

Lemma Trail_subgraph :
 forall (v v' : V_set) (a a' : A_set) (x y : Vertex)
   (vl : V_list) (el : E_list),
 Trail v a x y vl el ->
 V_included v v' -> A_included a a' -> Trail v' a' x y vl el.
Proof.
        intros; elim H; intros.
        apply T_null; apply (H0 x0); trivial.

        apply T_step.
        trivial.

        apply (H0 x0); trivial.

        apply (H1 (A_ends x0 y0)); trivial.

        trivial.
Qed.

Lemma Path_subgraph :
 forall (v v' : V_set) (a a' : A_set) (x y : Vertex)
   (vl : V_list) (el : E_list),
 Path v a x y vl el ->
 V_included v v' -> A_included a a' -> Path v' a' x y vl el.
Proof.
        intros; elim H; intros.
        apply P_null; apply (H0 x0); trivial.

        apply P_step.
        trivial.

        apply (H0 x0); trivial.

        apply (H1 (A_ends x0 y0)); trivial.

        trivial.

        trivial.

        trivial.

        trivial.
Qed.

Lemma Path_supergraph_vertex :
 forall (v v' : V_set) (a : A_set) (x y : Vertex) (vl : V_list) (el : E_list),
 Path v a x y vl el ->
 v' x -> (forall z : Vertex, In z vl -> v' z) -> Path v' a x y vl el.
Proof.
        intros v v' a x y vl el p; elim p; intros.
        apply P_null; trivial.

        apply P_step.
        apply H.
        apply H1; simpl in |- *; auto.

        intros; apply H1; simpl in |- *; auto.

        trivial.

        trivial.

        trivial.

        trivial.

        trivial.

        trivial.
Qed.

Lemma Path_supergraph_cons_vertex :
 forall (v : V_set) (a : A_set) (x y z : Vertex) (vl : V_list) (el : E_list),
 Path (V_union (V_single z) v) a x y vl el ->
 z <> x -> ~ In z vl -> Path v a x y vl el.
Proof.
        intros v a x y z vl el p; elim p; intros.
        apply P_null.
        inversion v0.
        inversion H1; absurd (z = x0); auto.

        trivial.

        apply P_step.
        apply H.
        red in |- *; intros; elim H1.
        rewrite H2; simpl in |- *; auto.

        red in |- *; intros; elim H1; simpl in |- *; auto.

        inversion v0.
        inversion H2; absurd (z = x0); auto.

        trivial.

        trivial.

        trivial.

        trivial.

        trivial.

        trivial.
Qed.

Lemma Path_supergraph_arc :
 forall (v v' : V_set) (a a' : A_set) (x y : Vertex)
   (vl : V_list) (el : E_list),
 Path v a x y vl el ->
 Graph v' a' ->
 v' x ->
 (forall x' y' : Vertex, In (E_ends x' y') el -> a' (A_ends x' y')) ->
 Path v' a' x y vl el.
Proof.
        intros v v' a a' x y vl el p; elim p; intros.
        apply P_null; trivial.

        apply P_step.
        apply H.
        trivial.

        apply (G_ina_inv2 v' a' H0 x0 y0).
        apply H2; simpl in |- *; auto.

        intros; apply H2; simpl in |- *; auto.

        trivial.

        apply H2; simpl in |- *; auto.

        trivial.

        trivial.

        trivial.

        trivial.
Qed.

Lemma Path_supergraph_cons_arc :
 forall (v : V_set) (a : A_set) (x y x' y' : Vertex)
   (vl : V_list) (el : E_list),
 Path v (A_union (E_set x' y') a) x y vl el ->
 ~ In (E_ends x' y') el -> ~ In (E_ends y' x') el -> Path v a x y vl el.
Proof.
        intros v a x y x' y' vl el p; elim p; intros.
        apply P_null; trivial.

        apply P_step.
        apply H.
        red in |- *; intros; elim H0.
        simpl in |- *; auto.

        red in |- *; intros; elim H1; simpl in |- *; auto.

        trivial.

        inversion a0.
        inversion H2.
        absurd (In (E_ends x' y') (E_ends x0 y0 :: el0)).
        trivial.

        rewrite H5; rewrite H6; simpl in |- *; auto.

        absurd (In (E_ends y' x') (E_ends x0 y0 :: el0)).
        trivial.

        rewrite H5; rewrite H6; simpl in |- *; auto.

        trivial.

        trivial.

        trivial.

        trivial.

        trivial.
Qed.

End PATH_IN_A_SUBGRAPH.

Section APPEND_WALKS.

Variable v : V_set.
Variable a : A_set.

Lemma Walk_append :
 forall (x y z : Vertex) (vl vl' : V_list) (el el' : E_list),
 Walk v a x y vl el ->
 Walk v a y z vl' el' -> Walk v a x z (vl ++ vl') (el ++ el').
Proof.
        intros x y z vl vl' el el' Hw; elim Hw; simpl in |- *; intros.
        trivial.

        apply W_step; auto.
Qed.

End APPEND_WALKS.

Section REVERSE_WALK.

Variable v : V_set.
Variable a : A_set.
Variable g : Graph v a.

Definition cdr (vl : V_list) : V_list :=
  match vl with
  | nil => V_nil
  | x :: vl' => vl'
  end.

Lemma cdr_app :
 forall vl vl' : V_list, vl <> V_nil -> cdr (vl ++ vl') = cdr vl ++ vl'.
Proof.
        simple induction vl; simpl in |- *; intros.
        absurd (V_nil = V_nil); auto.

        trivial.
Qed.

Fixpoint E_reverse (el : E_list) : E_list :=
  match el with
  | nil => E_nil
  | E_ends x y :: el' => E_reverse el' ++ E_ends y x :: E_nil
  end.

Lemma G_ends_in : forall x y : Vertex, a (A_ends x y) -> v x.
Proof.
        elim g; intros.
        inversion H.

        case (V_eq_dec x x0); intros.
        rewrite e; apply V_in_left; apply V_in_single.

        apply V_in_right; apply (H x0 y); trivial.

        inversion H0.
        inversion H1; rewrite <- H4; trivial.

        apply (H x0 y0); trivial.

        rewrite <- e; apply (H x y); rewrite e0; trivial.
Qed.

Lemma Walk_reverse :
 forall (x y : Vertex) (vl : V_list) (el : E_list),
 Walk v a x y vl el -> Walk v a y x (cdr (rev (x :: vl))) (E_reverse el).
Proof.
        intros; elim H; simpl in |- *; intros.
        apply W_null; trivial.

        rewrite cdr_app.
        apply (Walk_append v a z y0 x0).
        trivial.

        apply W_step.
        apply W_null; trivial.

        apply (G_ina_inv2 v a g x0 y0); trivial.

        apply (G_non_directed v a g); trivial.

        case (rev vl0); intros; simpl in |- *; discriminate.
Qed.

End REVERSE_WALK.


(***************************************************************************
* Cardinality lemmas                                                       *
* Jacques Garrigue, July 2008                                              *
***************************************************************************)

Require Import List SetoidList Arith Omega Metatheory.
Set Implicit Arguments.

Lemma elements_empty : forall L,
  S.elements L = nil -> L = {}.
Proof.
  intros.
  apply eq_ext.
  intro. split; intro.
    use (S.elements_1 H0).
    rewrite H in H1.
    inversion H1.
  elim (in_empty H0).
Qed.

Lemma diff_empty_r : forall L, S.diff L {} = L.
  intros.
  apply eq_ext; intro; split; intro.
    apply* S.diff_1.
  apply* S.diff_3.
Qed.

Definition sort_lt_all := InfA_alt _ _ _.
(* Check sort_lt_all. *)

Lemma sort_lt_notin : forall a l0,
  sort S.E.lt l0 ->
  lelistA S.E.lt a l0 ->
  ~ InA S.E.eq a l0.
Proof.
  intros.
  intro.
  use (proj1 (sort_lt_all a H) H0 _ H1).
  elim (S.E.lt_not_eq _ _ H2). reflexivity.
Qed.

Definition sort_lt_nodup (l : list var) := SortA_NoDupA _ _ _ (l:=l).
(* Check sort_lt_nodup. *)

Lemma sort_lt_ext : forall l1 l2,
  sort S.E.lt l1 -> sort S.E.lt l2 ->
  (forall a, InA S.E.eq a l1 <-> InA S.E.eq a l2) -> l1 = l2.
Proof.
  intros.
  gen l2; induction H; intros.
      destruct* l2.
    use (proj2 (H1 t) (InA_cons_hd l2 (refl_equal t))).
    inversions H.
  inversions H1.
    use (proj1 (H2 a) (InA_cons_hd l (refl_equal a))).
    inversion H3.
  destruct (S.E.compare a a0).
      elim (sort_lt_notin H1 (cons_leA _ _ _ _ l1)).
      apply* (proj1 (H2 a)). auto with ordered_type.
    rewrite <- e in *. clear e a0.
    rewrite* (IHSorted l0).
    intro; split; intro.
      destruct (a0 == a).
        subst.
        elim (sort_lt_notin H H0 H5).
      use (proj1 (H2 a0) (InA_cons_tl a H5)).
      inversions* H6.
    destruct (a0 == a).
      subst.
      elim (sort_lt_notin H3 H4 H5).
    use (proj2 (H2 a0) (InA_cons_tl a H5)).
    inversions* H6.
  elim (sort_lt_notin (cons_sort H H0) (cons_leA _ _ _ _ l1)).
  apply* (proj2 (H2 a0)). auto with ordered_type.
Qed.

Lemma remove_union : forall a L1 L2,
  S.remove a (L1 \u L2) = S.remove a L1 \u S.remove a L2.
Proof.
  intros; apply eq_ext; intro; split; intro; sets_solve.
Qed.

Lemma nodup_notin_split : forall a l2 l1,
  NoDupA S.E.eq (l1 ++ a :: l2) -> ~InA S.E.eq a l1 /\ ~InA S.E.eq a l2.
Proof.
  induction l1; simpl; intro; inversions H.
    split2*. intro. inversion H0.
  destruct (IHl1 H3).
  split2*.
  intro. inversions H4.
    elim H2.
    apply (InA_eqA _ H6 (l:=l1++a::l2)).
    apply (In_InA _).
    apply in_or_app. simpl*.
  elim (H0 H6).
Qed.

Lemma diff_remove : forall a L1 L2,
  a \in L2 -> S.diff (S.remove a L1) (S.remove a L2) = S.diff L1 L2.
Proof.
  intros.
  apply eq_ext; intros; split; intro; sets_solve.
    apply* S.diff_3.
    destruct* (a == a0).
    intro.
    elim Hn.
    apply* S.remove_2.
  apply S.diff_3.
    apply* S.remove_2.
    intros Haa0.
    rewrite Haa0 in H.
    now elim Hn.
  intro; elim Hn.
  apply* S.remove_3.
Qed.

Lemma sort_tl : forall a l, sort S.E.lt (a::l) -> sort S.E.lt l.
Proof.
  intros. inversions* H.
Qed.

Lemma sort_lelistA : forall a l,
  sort S.E.lt (a::l) -> lelistA S.E.lt a l.
Proof.
  intros. inversions* H.
Qed.

Hint Resolve sort_tl sort_lelistA : core.

Lemma sort_split : forall y l2 l1,
  sort S.E.lt (l1 ++ y :: l2) -> sort S.E.lt (l1 ++ l2).
Proof.
  induction l1; simpl; intros. eauto.
  constructor. eauto.
  destruct l1; simpl in *.
    inversions H.
    inversions H3.
    apply* (InfA_ltA _).
    inversions* H.
  inversions* H3.
Qed.

Lemma elements_tl : forall a elts L,
  S.elements L = a :: elts -> S.elements (S.remove a L) = elts.
Proof.
  intros.
  apply sort_lt_ext.
      apply S.elements_3.
    use (S.elements_3 L).
    rewrite H in H0.
    inversions* H0.
  intro; split; intro.
    use (S.elements_2 H0).
    use (S.remove_3 H1).
    use (S.elements_1 H2).
    rewrite H in H3.
    inversions* H3.
    elim (S.remove_1 (sym_eq H5) H1).
  apply S.elements_1.
  apply S.remove_2.
    intro.
    rewrite H1 in H.
    use (sort_lt_nodup (S.elements_3 L)).
    rewrite H in H2.
    inversions* H2.
  apply S.elements_2.
  rewrite* H.
Qed.

Lemma remove_remove : forall L a b,
  S.remove a (S.remove b L) = S.remove b (S.remove a L).
Proof.
  intro.
  assert (forall a b x, x \in S.remove a (S.remove b L) ->
                        x \in S.remove b (S.remove a L)).
    intros; sets_solve.
  intros.
  apply eq_ext; intro; split; intro; sets_solve.
Qed.

Lemma remove_idem : forall a L,
  S.remove a (S.remove a L) = S.remove a L.
Proof.
  intros; apply eq_ext; intro; split; intro; sets_solve.
Qed.

Lemma elements_remove : forall a L,
  S.elements (S.remove a L) = removeA eq_var_dec a (S.elements L).
Proof.
  intros.
  remember (S.elements L) as elts.
  gen L; induction elts; simpl; intros.
    apply sort_lt_ext. apply S.elements_3.
      auto.
    intro; split; intro.
      use (S.elements_1 (S.remove_3 (S.elements_2 H))).
      rewrite <- Heqelts in H0.
      inversion H0.
    inversion H.
  destruct (a == a0).
    subst.
    rewrite <- (IHelts (S.remove a0 L)).
      rewrite* remove_idem.
    apply sym_eq.
    apply* elements_tl.
  rewrite <- (IHelts (S.remove a0 L)); clear IHelts.
    apply sort_lt_ext. apply S.elements_3.
      constructor. apply S.elements_3.
      apply (InA_InfA _).
      intros.
      use (S.remove_3 (S.elements_2 H)).
      use (elements_tl (sym_equal Heqelts)).
      use (S.elements_1 H0).
      rewrite H1 in H2.
      use (S.elements_3 L).
      rewrite <- Heqelts in H3.
      inversions H3.
      use (sort_lt_all a0 H6).
    rewrite remove_remove.
    intro; split; intro.
      destruct* (a1 == a0).
      apply InA_cons_tl.
      auto with sets.
    destruct (a0 == a1).
      subst.
      apply S.elements_1.
      apply* S.remove_2.
      apply S.elements_2.
      rewrite* <- Heqelts. auto with ordered_type.
    inversions H. elim n0; auto.
    eauto with sets.
  rewrite* <- (@elements_tl a0 elts L).
Qed.

Lemma cardinal_union : forall L1 L2,
  S.cardinal (L1 \u L2) = S.cardinal L2 + S.cardinal (S.diff L1 L2).
Proof.
  intros.
  repeat rewrite S.cardinal_1.
  remember (S.elements (L1 \u L2)) as elts.
  remember (S.elements L2) as elts2.
  remember (S.elements (S.diff L1 L2)) as elts1.
  gen L1 L2 elts1 elts.
  induction elts2; intros.
    use (elements_empty (sym_equal Heqelts2)).
    subst.
    rewrite diff_empty_r.
    rewrite* union_empty_r.
  use (elements_tl (sym_equal Heqelts2)).
  assert (a \in L2).
    apply S.elements_2.
    rewrite* <- Heqelts2.
    auto with ordered_type.
  assert (InA S.E.eq a elts).
    subst.
    auto with sets.
  subst.
  destruct (InA_split H1) as [l1 [y [l2 [Hl1 Hl]]]].
  rewrite Hl.
  rewrite app_length.
  simpl. rewrite <- plus_n_Sm.
  rewrite <- app_length.
  apply (f_equal S).
  apply* (IHelts2 (S.remove a L1) (S.remove a L2)); clear IHelts2.
    apply (f_equal S.elements).
    rewrite* diff_remove.
  apply sort_lt_ext.
      use (S.elements_3 (L1 \u L2)).
      rewrite Hl in H.
      apply* sort_split.
    apply S.elements_3.
  intro; split; intro.
    apply S.elements_1.
    rewrite <- remove_union.
    rewrite <- Hl1 in *; clear Hl1 y.
    use (S.elements_3 (L1 \u L2)).
    destruct (a == a0).
      rewrite Hl in H2.
      use (sort_lt_nodup H2).
      destruct (nodup_notin_split _ _ _ H3).
      subst; destruct* (InA_app H).
    apply* S.remove_2.
    apply S.elements_2.
    rewrite Hl.
    clear -H.
    induction l1; simpl in *. auto.
    inversions* H.
  rewrite <- Hl1 in *; clear Hl1 y.
  use (S.elements_2 H).
  rewrite <- remove_union in H2.
  use (S.remove_3 H2).
  use (S.elements_1 H3).
  rewrite Hl in H4.
  clear -H2 H4.
  induction l1; simpl in *; inversions* H4.
  elim (S.remove_1 (sym_equal H0) H2).
Qed.

Lemma cardinal_remove : forall a L,
  a \in L ->
  S (S.cardinal (S.remove a L)) = S.cardinal L.
Proof.
  intros.
  repeat rewrite S.cardinal_1.
  rewrite elements_remove.
  use (sort_lt_nodup (S.elements_3 L)).
  use (S.elements_1 H).
  clear H; induction H1.
    rewrite H.
    simpl.
    destruct* (y == y).
    inversions H0.
    clear -H3; induction l. auto.
    simpl.
    destruct (y==a). elim H3; auto.
    simpl; rewrite* IHl.
  simpl.
  inversions H0.
  destruct* (a==y).
  subst*.
Qed.

Lemma remove_subset : forall x L1 L2, L1 << L2 ->
  forall y, y \in S.remove x L1 -> y \in S.remove x L2.
Proof.
  intros.
  apply S.remove_2.
    intro Hx; elim (S.remove_1 Hx H0).
  apply H; apply* S.remove_3.
Qed.

Lemma cardinal_subset : forall L1 L2,
  L1 << L2 -> S.cardinal L1 <= S.cardinal L2.
Proof.
  intro.
  repeat rewrite S.cardinal_1.
  remember (S.elements L1) as elts1.
  gen L1; induction elts1; simpl; intros.
    omega.
  use (elements_tl (sym_eq Heqelts1)).
  use (IHelts1 _ (sym_eq H0) (S.remove a L2)).
  use (H1 (remove_subset H)).
  assert (a \in L2).
    apply H.
    apply S.elements_2.
    rewrite* <- Heqelts1.
    auto with ordered_type.
  rewrite <- (cardinal_remove H3).
  omega.
Qed.

Lemma cardinal_empty : S.cardinal {} = 0.
Proof.
  rewrite S.cardinal_1.
  case_eq (S.elements {}); intros. simpl*.
  assert (In e (e::l)) by auto.
  rewrite <- H in H0.
  assert (e \in {}). auto with sets ordered_type.
  elim (in_empty H1).
Qed.

Lemma cardinal_0 : forall L,
  S.cardinal L = 0 -> L = {}.
Proof.
  intros.
  rewrite S.cardinal_1 in H.
  case_rewrite R1 (S.elements L).
  apply eq_ext; intros; split; intro; intros; sets_solve.
  use (S.elements_1 H0).
  rewrite R1 in H1.
  inversion H1.
Qed.