(*
  This file defines an inductive type [chUniverse] and a total order on that type, which
  is then used to show that [chUniverse] forms a [choiceType].
 *)

From Coq Require Import Utf8 Lia.
From Relational Require Import OrderEnrichedCategory
  OrderEnrichedRelativeMonadExamples GenericRulesSimple.
Set Warnings "-ambiguous-paths,-notation-overridden,-notation-incompatible-format".
From mathcomp Require Import ssrnat ssreflect ssrfun ssrbool ssrnum eqtype
  choice reals distr realsum seq all_algebra fintype.
Set Warnings "ambiguous-paths,notation-overridden,notation-incompatible-format".
From Crypt Require Import Prelude Axioms.
From extructures Require Import ord fset fmap.
From Mon Require Import SPropBase.
Require Equations.Prop.DepElim.
From Equations Require Import Equations.

Set Equations With UIP.

Import SPropNotations.

Set Bullet Behavior "Strict Subproofs".
Set Default Goal Selector "!".
Set Primitive Projections.

Open Scope fset.
Open Scope fset_scope.
Open Scope type_scope.

(* Basic structure *)

Inductive chUniverse :=
| chUnit
| chNat
| chBool
| chProd (A B : chUniverse)
| chMap (A B : chUniverse)
| chOption (A : chUniverse)
| chFin (n : positive).

Derive NoConfusion NoConfusionHom for chUniverse.

(* Definition void_leq (x y : void) := true. *)

(* Lemma void_leqP : Ord.axioms void_leq. *)
(* Proof. split; by do ![case]. Qed. *)

(* Definition void_ordMixin := OrdMixin void_leqP. *)
(* Canonical void_ordType := Eval hnf in OrdType void void_ordMixin. *)

Fixpoint chElement_ordType (U : chUniverse) : ordType :=
  match U with
  | chUnit => unit_ordType
  | chNat => nat_ordType
  | chBool => bool_ordType
  | chProd U1 U2 => prod_ordType (chElement_ordType U1) (chElement_ordType U2)
  | chMap U1 U2 => fmap_ordType (chElement_ordType U1) (chElement_ordType U2)
  | chOption U => option_ordType (chElement_ordType U)
  | chFin n => [ordType of ordinal n.(pos) ]
  end.

Fixpoint chElement (U : chUniverse) : choiceType :=
  match U with
  | chUnit => unit_choiceType
  | chNat => nat_choiceType
  | chBool => bool_choiceType
  | chProd U1 U2 => prod_choiceType (chElement U1) (chElement U2)
  | chMap U1 U2 => fmap_choiceType (chElement_ordType U1) (chElement U2)
  | chOption U => option_choiceType (chElement U)
  | chFin n => [choiceType of ordinal n.(pos) ]
  end.

Coercion chElement : chUniverse >-> choiceType.

(* Canonical element in a type of the chUniverse *)
#[program] Fixpoint chCanonical (T : chUniverse) : T :=
  match T with
  | chUnit => Datatypes.tt
  | chNat => 0
  | chBool => false
  | chProd A B => (chCanonical A, chCanonical B)
  | chMap A B => _
  | chOption A => None
  | chFin n => _
  end.
Next Obligation.
  eapply fmap_of_fmap. apply emptym.
Defined.
Next Obligation.
  exists 0. destruct n as [p h]. simpl.
  unfold Positive in h. auto.
Defined.

Section chUniverseTypes.

  Fixpoint chUniverse_test (u v : chUniverse) : bool :=
    match u, v with
    | chNat , chNat => true
    | chUnit , chUnit => true
    | chBool , chBool => true
    | chProd a b , chProd a' b' => chUniverse_test a a' && chUniverse_test b b'
    | chMap a b , chMap a' b' => chUniverse_test a a' && chUniverse_test b b'
    | chOption a, chOption a' => chUniverse_test a a'
    | chFin n, chFin n' => n == n'
    | _ , _ => false
    end.

  Definition chUniverse_eq : rel chUniverse :=
    fun u v => chUniverse_test u v.

  Lemma chUniverse_eqP : Equality.axiom chUniverse_eq.
  Proof.
    move=> x y.
    induction x as [ | | | x1 ih1 x2 ih2 | x1 ih1 x2 ih2 | x1 ih1 | x1]
    in y |- *.
    all: destruct y as [ | | | y1 y2 | y1 y2 | y1 | y1].
    all: simpl.
    all: try solve [ right ; discriminate ].
    all: try solve [ left ; reflexivity ].
    - destruct (ih1 y1), (ih2 y2).
      all: simpl.
      all: subst.
      all: try solve [ right ; congruence ].
      left. reflexivity.
    - destruct (ih1 y1), (ih2 y2).
      all: simpl.
      all: subst.
      all: try solve [ right ; congruence ].
      left. reflexivity.
    - destruct (ih1 y1).
      all: subst.
      + left. reflexivity.
      + right. congruence.
    - destruct (x1 == y1) eqn:e.
      + move: e => /eqP e. subst. left. reflexivity.
      + move: e => /eqP e. right. intro h.
        apply e. inversion h. reflexivity.
  Qed.

  Lemma chUniverse_refl :
    ∀ u, chUniverse_eq u u.
  Proof.
    intros u. destruct chUniverse_eq eqn:e.
    - constructor.
    - move: e => /chUniverse_eqP []. reflexivity.
  Qed.

  Canonical chUniverse_eqMixin := EqMixin chUniverse_eqP.
  Canonical chUniverse_eqType :=
    Eval hnf in EqType chUniverse chUniverse_eqMixin.

  Fixpoint chUniverse_lt (t1 t2 : chUniverse) :=
  match t1, t2 with
  | chUnit, chUnit => false
  | chUnit, _ => true
  | chBool, chUnit => false
  | chBool, chBool => false
  | chBool, _ => true
  | chNat, chUnit => false
  | chNat, chBool => false
  | chNat, chNat => false
  | chNat, _ => true
  | chProd _ _, chUnit => false
  | chProd _ _, chBool => false
  | chProd _ _, chNat => false
  | chProd u1 u2, chProd w1 w2 =>
    (chUniverse_lt u1 w1) ||
    (chUniverse_eq u1 w1 && chUniverse_lt u2 w2)
  | chProd _ _, _ => true
  | chMap _ _, chUnit => false
  | chMap _ _, chBool => false
  | chMap _ _, chNat => false
  | chMap _ _, chProd _ _ => false
  | chMap u1 u2, chMap w1 w2 =>
    (chUniverse_lt u1 w1) ||
    (chUniverse_eq u1 w1 && chUniverse_lt u2 w2)
  | chMap _ _, _ => true
  | chOption _, chUnit => false
  | chOption _, chBool => false
  | chOption _, chNat => false
  | chOption _, chProd _ _ => false
  | chOption _, chMap _ _ => false
  | chOption u, chOption w => chUniverse_lt u w
  | chOption _, _ => true
  | chFin n, chUnit => false
  | chFin n, chBool => false
  | chFin n, chNat => false
  | chFin n, chProd _ _ => false
  | chFin n, chMap _ _ => false
  | chFin n, chOption _ => false
  | chFin n, chFin n' => n < n'
  end.

  Definition chUniverse_leq (t1 t2 : chUniverse) :=
    chUniverse_eq t1 t2 || chUniverse_lt t1 t2.

  Lemma chUniverse_lt_transitive : transitive (T:=chUniverse) chUniverse_lt.
  Proof.
    intros v u w h1 h2.
    induction u as [ | | | u1 ih1 u2 ih2 | u1 ih1 u2 ih2 | u ih | u]
    in v, w, h1, h2 |- *.
    - destruct w. all: try auto.
      destruct v. all: discriminate.
    - destruct w. all: try auto.
      all: destruct v. all: discriminate.
    - destruct w. all: try auto.
      all: destruct v. all: discriminate.
    - destruct v. all: try discriminate.
      all: destruct w. all: try discriminate. all: try reflexivity.
      cbn in *.
      move: h1 => /orP h1.
      move: h2 => /orP h2.
      apply/orP.
      destruct h1 as [h1|h1], h2 as [h2|h2].
      + left. eapply ih1. all: eauto.
      + left. move: h2 => /andP [/eqP e h2]. subst. auto.
      + left. move: h1 => /andP [/eqP e h1]. subst. auto.
      + right. move: h1 => /andP [/eqP e1 h1].
        move: h2 => /andP [/eqP e2 h2].
        apply/andP. subst. split.
        * apply/eqP. reflexivity.
        * eapply ih2. all: eauto.
    - destruct v. all: try discriminate.
      all: destruct w. all: try discriminate. all: try reflexivity.
      simpl in *.
      move: h1 => /orP h1.
      move: h2 => /orP h2.
      apply/orP.
      destruct h1 as [h1|h1], h2 as [h2|h2].
      + left. eapply ih1. all: eauto.
      + left. move: h2 => /andP [/eqP e h2]. subst. auto.
      + left. move: h1 => /andP [/eqP e h1]. subst. auto.
      + right. move: h1 => /andP [/eqP e1 h1].
        move: h2 => /andP [/eqP e2 h2].
        apply/andP. subst. split.
        * apply/eqP. reflexivity.
        * eapply ih2. all: eauto.
    - destruct v. all: try discriminate.
      all: destruct w. all: try reflexivity. all: try discriminate.
      simpl in *.
      eapply ih. all: eauto.
    - destruct v. all: try discriminate.
      destruct w. all: try discriminate.
      simpl in *.
      eapply ltn_trans. all: eauto.
  Qed.

  Lemma chUniverse_lt_areflexive :
    ∀ x, ~~ chUniverse_lt x x.
  Proof.
    intros x.
    induction x as [ | | | x1 ih1 x2 ih2 | x1 ih1 x2 ih2 | x ih | x] in |- *.
    all: intuition; simpl.
    - simpl.
      apply/norP. split.
      + apply ih1.
      + apply/nandP.
        right. apply ih2.
    - simpl.
      apply/norP. split.
      + apply ih1.
      + apply/nandP.
        right. apply ih2.
    - rewrite ltnn. auto.
  Qed.

  Lemma chUniverse_lt_total_holds :
    ∀ x y,
      ~~ (chUniverse_test x y) ==> (chUniverse_lt x y || chUniverse_lt y x).
  Proof.
    intros x y.
    induction x as [ | | | x1 ih1 x2 ih2| x1 ih1 x2 ih2| x ih| x]
    in y |- *.
    all: try solve [ destruct y ; intuition ; reflexivity ].
    - destruct y. all: try (intuition; reflexivity).
      cbn.
      specialize (ih1 y1). specialize (ih2 y2).
      apply/implyP.
      move /nandP => H.
      apply/orP.
      destruct (chUniverse_test x1 y1) eqn:Heq.
      + destruct H. 1: discriminate.
        move: ih2. move /implyP => ih2.
        specialize (ih2 H).
        move: ih2. move /orP => ih2.
        destruct ih2.
        * left. apply/orP. right. apply/andP. split.
          all: intuition auto.
        * right. apply/orP. right. apply/andP. intuition.
          move: Heq. move /eqP => Heq. rewrite Heq. apply/eqP. reflexivity.
      + destruct H.
        * move: ih1. move /implyP => ih1.
          specialize (ih1 H).
          move: ih1. move /orP => ih1.
          destruct ih1.
          -- left. apply/orP. left. assumption.
          -- right. apply/orP. left. assumption.
        * move: ih2. move /implyP => ih2.
          specialize (ih2 H).
          move: ih2. move /orP => ih2.
          destruct ih2.
          --- simpl in ih1.  move: ih1. move /orP => ih1.
              destruct ih1.
              +++ left. apply/orP. left. assumption.
              +++ right. apply/orP. left. assumption.
          --- simpl in ih1.  move: ih1. move /orP => ih1.
              destruct ih1.
              +++ left. apply/orP. left. assumption.
              +++ right. apply/orP. left. assumption.
    - destruct y. all: try (intuition; reflexivity).
      cbn.
      specialize (ih1 y1). specialize (ih2 y2).
      apply/implyP.
      move /nandP => H.
      apply/orP.
      destruct (chUniverse_test x1 y1) eqn:Heq.
      + destruct H. 1: discriminate.
        move: ih2. move /implyP => ih2.
        specialize (ih2 H).
        move: ih2. move /orP => ih2.
        destruct ih2.
        * left. apply/orP. right. apply/andP. split.
          all: intuition auto.
        * right. apply/orP. right. apply/andP. intuition.
          move: Heq. move /eqP => Heq. rewrite Heq. apply/eqP. reflexivity.
      + destruct H.
        * move: ih1. move /implyP => ih1.
          specialize (ih1 H).
          move: ih1. move /orP => ih1.
          destruct ih1.
          -- left. apply/orP. left. assumption.
          -- right. apply/orP. left. assumption.
        * move: ih2. move /implyP => ih2.
          specialize (ih2 H).
          move: ih2. move /orP => ih2.
          destruct ih2.
          --- simpl in ih1. move: ih1. move /orP => ih1.
              destruct ih1.
              +++ left. apply/orP. left. assumption.
              +++ right. apply/orP. left. assumption.
          --- simpl in ih1. move: ih1. move /orP => ih1.
              destruct ih1.
              +++ left. apply/orP. left. assumption.
              +++ right. apply/orP. left. assumption.
    - destruct y. all: try (intuition; reflexivity).
      unfold chUniverse_lt.
      unfold chUniverse_test.
      rewrite -neq_ltn.
      apply /implyP. auto.
  Qed.

  Lemma chUniverse_lt_asymmetric :
    ∀ x y,
      (chUniverse_lt x y ==> ~~ chUniverse_lt y x).
  Proof.
    intros x y.
    apply /implyP. move => H.
    destruct (~~ chUniverse_lt y x) eqn:Heq.
    - intuition.
    - move: Heq. move /negP /negP => Heq.
      pose  (chUniverse_lt_areflexive x) as Harefl.
      move: Harefl. apply /implyP. rewrite implyNb.
      apply /orP. left.
      apply (chUniverse_lt_transitive _ _ _ H Heq).
  Qed.

  Lemma chUniverse_lt_total_not_holds :
    ∀ x y,
      ~~ (chUniverse_test x y) ==> (~~ (chUniverse_lt x y && chUniverse_lt y x)).
  Proof.
    intros x y. apply /implyP. intros Hneq.
    pose (chUniverse_lt_total_holds x y) as Htot.
    move: Htot. move /implyP => Htot. specialize (Htot Hneq).
    move: Htot. move /orP => Htot. apply /nandP. destruct Htot.
    - right. pose (chUniverse_lt_asymmetric x y) as Hasym.
      move: Hasym. move /implyP => Hasym. specialize (Hasym H). assumption.
    - left. pose (chUniverse_lt_asymmetric y x) as Hasym.
      move: Hasym. move /implyP => Hasym. specialize (Hasym H). assumption.
  Qed.

  Lemma chUniverse_lt_tot :
    ∀ x y,
      (chUniverse_lt x y || chUniverse_lt y x || chUniverse_eq x y).
  Proof.
    intros x y.
    destruct (chUniverse_eq x y) eqn:H.
    - intuition.
    - apply/orP.
      left.
      unfold chUniverse_eq in H.
      pose (chUniverse_lt_total_holds x y).
      move: i. move /implyP => i.
      apply i. apply/negP.
      intuition. move: H0. rewrite H. intuition.
  Qed.

  Lemma chUniverse_leqP : Ord.axioms chUniverse_leq.
  Proof.
    split => //.
    - intro x. unfold chUniverse_leq.
      apply/orP. left. apply /eqP. reflexivity.
    - intros v u w h1 h2.
      move: h1 h2. unfold chUniverse_leq.
      move /orP => h1. move /orP => h2.
      destruct h1.
      + move: H. move /eqP => H. destruct H.
        apply/orP. assumption.
      + destruct h2.
        * move: H0. move /eqP => H0. destruct H0.
          apply/orP. right. assumption.
        * apply/orP. right. exact (chUniverse_lt_transitive _ _ _ H H0).
    - unfold antisymmetric.
      move => x y. unfold chUniverse_leq. move/andP => [h1 h2].
      move: h1 h2. unfold chUniverse_leq.
      move /orP => h1. move /orP => h2.
      destruct h1.
      1:{ move: H. move /eqP. intuition auto. }
      destruct h2.
      1:{ move: H0. move /eqP. intuition auto. }
      destruct (~~ (chUniverse_test x y)) eqn:Heq.
      + move: Heq. move /idP => Heq.
        pose (chUniverse_lt_total_not_holds x y) as Hp.
        move: Hp. move /implyP => Hp. specialize (Hp Heq).
        move: Hp. move /nandP => Hp.
        destruct Hp.
        * move: H. move /eqP /eqP => H. rewrite H in H1. simpl in H1.
          discriminate.
        * move: H0. move /eqP /eqP => H0. rewrite H0 in H1. simpl in H1.
          discriminate.
      + move: Heq. move /eqP. auto.
    - unfold total.
      intros x y. unfold chUniverse_leq.
      pose (chUniverse_lt_tot x y).
      move: i. move /orP => H.
      destruct H.
      + move: H. move /orP => H.
        destruct H.
        * apply/orP. left. apply/orP. right. assumption.
        * apply/orP. right. apply/orP. right. assumption.
      + apply/orP. left. apply/orP. left. assumption.
  Qed.

  Fixpoint encode (t : chUniverse) : GenTree.tree nat :=
  match t with
  | chUnit => GenTree.Leaf 1
  | chBool => GenTree.Leaf 2
  | chNat => GenTree.Leaf 3
  | chProd l r => GenTree.Node 1 [:: encode l ; encode r]
  | chMap l r => GenTree.Node 2 [:: encode l ; encode r]
  | chOption u => GenTree.Node 3 [:: encode u]
  | chFin n => GenTree.Leaf ((4 + n) - 1)%N
  end.

  Fixpoint decode (t : GenTree.tree nat) : option chUniverse :=
    match t with
    | GenTree.Leaf 1 => Some chUnit
    | GenTree.Leaf 2 => Some chBool
    | GenTree.Leaf 3 => Some chNat
    | GenTree.Leaf n =>
      Some ( chFin (mkpos ((n - 4).+1)%N) )
    | GenTree.Node 1 [:: l ; r] =>
      match decode l, decode r with
      | Some l, Some r => Some (chProd l r)
      | _, _ => None
      end
    | GenTree.Node 2 [:: l ; r] =>
      match decode l, decode r with
      | Some l, Some r => Some (chMap l r)
      | _, _ => None
      end
    | GenTree.Node 3 [:: l] =>
      match decode l with
      | Some l => Some (chOption l)
      | _ => None
      end
    | _ => None
    end.

  Lemma codeK : pcancel encode decode.
  Proof.
    intro t. induction t.
    all: intuition.
    all: simpl.
    - rewrite IHt1. rewrite IHt2. reflexivity.
    - rewrite IHt1. rewrite IHt2. reflexivity.
    - rewrite IHt. reflexivity.
    - destruct n as [n npos]. cbn.
      destruct n.
      + discriminate.
      + cbn.
        rewrite -subnE subn0. repeat f_equal. apply eq_irrelevance.
  Defined.

  Definition chUniverse_choiceMixin := PcanChoiceMixin codeK.
  Canonical chUniverse_choiceType :=
    ChoiceType chUniverse chUniverse_choiceMixin.

  Definition chUniverse_ordMixin := OrdMixin chUniverse_leqP.
  Canonical chUniverse_ordType :=
    Eval hnf in OrdType chUniverse chUniverse_ordMixin.

End chUniverseTypes.


(* This file is generated by Why3's Coq driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require BuiltIn.
Require HighOrd.
Require int.Int.

Axiom set : forall (a:Type), Type.
Parameter set_WhyType : forall (a:Type) {a_WT:WhyType a}, WhyType (set a).
Existing Instance set_WhyType.

Parameter mem: forall {a:Type} {a_WT:WhyType a}, a -> (set a) -> Prop.

Parameter infix_eqeq:
  forall {a:Type} {a_WT:WhyType a}, (set a) -> (set a) -> Prop.

Axiom infix_eqeq_spec :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), (infix_eqeq s1 s2) -> forall (x:a),
  (mem x s1) -> mem x s2.

Axiom infix_eqeq_spec1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), (infix_eqeq s1 s2) -> forall (x:a),
  (mem x s2) -> mem x s1.

Axiom infix_eqeq_spec2 :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), (forall (x:a), (mem x s1) <-> (mem x s2)) ->
  infix_eqeq s1 s2.

Axiom extensionality :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), (infix_eqeq s1 s2) -> (s1 = s2).

Parameter subset:
  forall {a:Type} {a_WT:WhyType a}, (set a) -> (set a) -> Prop.

Axiom subset_spec :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), (subset s1 s2) -> forall (x:a), (mem x s1) ->
  mem x s2.

Axiom subset_spec1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), (forall (x:a), (mem x s1) -> mem x s2) ->
  subset s1 s2.

Axiom subset_refl :
  forall {a:Type} {a_WT:WhyType a}, forall (s:set a), subset s s.

Axiom subset_trans :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a) (s3:set a), (subset s1 s2) ->
  (subset s2 s3) -> subset s1 s3.

Parameter is_empty: forall {a:Type} {a_WT:WhyType a}, (set a) -> Prop.

Axiom is_empty_spec :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a), (is_empty s) -> forall (x:a), ~ (mem x s).

Axiom is_empty_spec1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a), (forall (x:a), ~ (mem x s)) -> is_empty s.

Parameter empty: forall {a:Type} {a_WT:WhyType a}, set a.

Axiom empty_def : forall {a:Type} {a_WT:WhyType a}, is_empty (empty : set a).

Parameter add: forall {a:Type} {a_WT:WhyType a}, a -> (set a) -> set a.

Axiom add_spec :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (s:set a), forall (y:a), (mem y (add x s)) ->
  (y = x) \/ (mem y s).

Axiom add_spec1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (s:set a), forall (y:a), (y = x) -> mem y (add x s).

Axiom add_spec2 :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (s:set a), forall (y:a), (mem y s) -> mem y (add x s).

Parameter remove: forall {a:Type} {a_WT:WhyType a}, a -> (set a) -> set a.

Axiom remove_spec :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (s:set a), forall (y:a), (mem y (remove x s)) -> ~ (y = x).

Axiom remove_spec1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (s:set a), forall (y:a), (mem y (remove x s)) -> mem y s.

Axiom remove_spec2 :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (s:set a), forall (y:a), (~ (y = x) /\ (mem y s)) ->
  mem y (remove x s).

Axiom add_remove :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (s:set a), (mem x s) -> ((add x (remove x s)) = s).

Axiom remove_add :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (s:set a), ((remove x (add x s)) = (remove x s)).

Axiom subset_remove :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (s:set a), subset (remove x s) s.

Parameter union:
  forall {a:Type} {a_WT:WhyType a}, (set a) -> (set a) -> set a.

Axiom union_spec :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), forall (x:a), (mem x (union s1 s2)) ->
  (mem x s1) \/ (mem x s2).

Axiom union_spec1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), forall (x:a), (mem x s1) ->
  mem x (union s1 s2).

Axiom union_spec2 :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), forall (x:a), (mem x s2) ->
  mem x (union s1 s2).

Parameter inter:
  forall {a:Type} {a_WT:WhyType a}, (set a) -> (set a) -> set a.

Axiom inter_spec :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), forall (x:a), (mem x (inter s1 s2)) ->
  mem x s1.

Axiom inter_spec1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), forall (x:a), (mem x (inter s1 s2)) ->
  mem x s2.

Axiom inter_spec2 :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), forall (x:a), ((mem x s1) /\ (mem x s2)) ->
  mem x (inter s1 s2).

Parameter diff:
  forall {a:Type} {a_WT:WhyType a}, (set a) -> (set a) -> set a.

Axiom diff_spec :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), forall (x:a), (mem x (diff s1 s2)) ->
  mem x s1.

Axiom diff_spec1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), forall (x:a), (mem x (diff s1 s2)) ->
  ~ (mem x s2).

Axiom diff_spec2 :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), forall (x:a), ((mem x s1) /\ ~ (mem x s2)) ->
  mem x (diff s1 s2).

Axiom subset_diff :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), subset (diff s1 s2) s1.

Parameter choose: forall {a:Type} {a_WT:WhyType a}, (set a) -> a.

Axiom choose_spec :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a), ~ (is_empty s) -> mem (choose s) s.

Parameter cardinal: forall {a:Type} {a_WT:WhyType a}, (set a) -> Z.

Axiom cardinal_nonneg :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a), (0%Z <= (cardinal s))%Z.

Axiom cardinal_empty :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a), ((cardinal s) = 0%Z) -> is_empty s.

Axiom cardinal_empty1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a), (is_empty s) -> ((cardinal s) = 0%Z).

Axiom cardinal_add :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a), forall (s:set a), ~ (mem x s) ->
  ((cardinal (add x s)) = (1%Z + (cardinal s))%Z).

Axiom cardinal_remove :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a), forall (s:set a), (mem x s) ->
  ((cardinal s) = (1%Z + (cardinal (remove x s)))%Z).

Axiom cardinal_subset :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), (subset s1 s2) ->
  ((cardinal s1) <= (cardinal s2))%Z.

Axiom subset_eq :
  forall {a:Type} {a_WT:WhyType a},
  forall (s1:set a) (s2:set a), (subset s1 s2) ->
  ((cardinal s1) = (cardinal s2)) -> infix_eqeq s1 s2.

Axiom cardinal1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a), ((cardinal s) = 1%Z) -> forall (x:a), (mem x s) ->
  (x = (choose s)).

Parameter filter:
  forall {a:Type} {a_WT:WhyType a}, (a -> bool) -> (set a) -> set a.

Axiom filter_def :
  forall {a:Type} {a_WT:WhyType a},
  forall (p:a -> bool) (u:set a), forall (x:a), (mem x (filter p u)) ->
  ((p x) = true).

Axiom filter_def1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (p:a -> bool) (u:set a), forall (x:a), (mem x (filter p u)) ->
  mem x u.

Axiom filter_def2 :
  forall {a:Type} {a_WT:WhyType a},
  forall (p:a -> bool) (u:set a), forall (x:a),
  (((p x) = true) /\ (mem x u)) -> mem x (filter p u).

Axiom filter_cardinal :
  forall {a:Type} {a_WT:WhyType a},
  forall (p:a -> bool) (u:set a), ((cardinal (filter p u)) <= (cardinal u))%Z.

Parameter map:
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b}, (a -> b) ->
  (set a) -> set b.

Axiom map_def1 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (f:a -> b) (u:set a), forall (y:b), (mem y (map f u)) ->
  exists x:a, (mem x u) /\ (y = (f x)).

Axiom map_def11 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (f:a -> b) (u:set a), forall (y:b),
  (exists x:a, (mem x u) /\ (y = (f x))) -> mem y (map f u).

Axiom map_def2 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (f:a -> b) (u:set a), forall (x:a), (mem x u) -> mem (f x) (map f u).

Axiom map_cardinal :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (f:a -> b) (u:set a), ((cardinal (map f u)) <= (cardinal u))%Z.

(* Why3 assumption *)
Inductive ref (a:Type) :=
  | mk_ref : a -> ref a.
Axiom ref_WhyType : forall (a:Type) {a_WT:WhyType a}, WhyType (ref a).
Existing Instance ref_WhyType.
Arguments mk_ref {a}.

(* Why3 assumption *)
Definition contents {a:Type} {a_WT:WhyType a} (v:ref a) : a :=
  match v with
  | mk_ref x => x
  end.

Axiom union_exchange :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a) (s':set a), ~ (is_empty s') ->
  ((union (add (choose s') s) (remove (choose s') s')) = (union s s')).

Axiom inter_empty :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a) (s':set a), (is_empty s) -> is_empty (inter s s').

Axiom inter_empty_comm :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a) (s':set a), (is_empty s') -> is_empty (inter s s').

Axiom union_empty :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a) (s':set a), (is_empty s) -> ((union s s') = s').

Axiom union_comm :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a) (s':set a), (is_empty s') -> ((union s s') = s).

Axiom union_empty_comm :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a) (s':set a), (is_empty s') -> ((union s s') = s).

Axiom set_subset :
  forall {a:Type} {a_WT:WhyType a},
  forall (s':set a) (s:set a), (forall (e:a), (mem e s') -> mem e s) ->
  subset s' s.

Axiom set_empty :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a), (forall (e:a), ~ (mem e s)) -> (s = (empty : set a)).

Axiom set_empty1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a), (forall (e:a), ~ (mem e s)) -> is_empty s.

Axiom set_equal :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a) (s':set a), (forall (e:a), (mem e s) -> mem e s') ->
  (forall (e:a), (mem e s') -> mem e s) -> (s = s').

Axiom get_empty :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a), (s = (empty : set a)) -> forall (e:a), ~ (mem e s).

Axiom get_empty1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a), (s = (empty : set a)) -> is_empty s.

Axiom union_add :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a) (s':set a) (x:a), ~ (mem x s') ->
  ((union s (add x s')) = (add x (union s s'))).

Axiom union_add_comm :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a) (s':set a) (x:a), ~ (mem x s') ->
  ((add x (union s s')) = (union s (add x s'))).

Axiom remove_add1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a) (x:a), ~ (mem x s) -> ((remove x (add x s)) = s).

Axiom add_remove1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a) (x:a), (mem x s) -> ((add x (remove x s)) = s).

(* Why3 assumption *)
Definition injective {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b}
    (s:set a) (f:a -> b) : Prop :=
  forall (a1:a) (b1:a), ~ (a1 = b1) -> ~ ((f a1) = (f b1)).

Axiom map_choose :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s:set a), forall (f:a -> b), ((choose (map f s)) = (f (choose s))).

Axiom map_remove_choose :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s:set a) (f:a -> b), (injective s f) ->
  ((map f (remove (choose s) s)) = (remove (choose (map f s)) (map f s))).

Parameter right_injections:
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b}, a -> (set b) ->
  set (a* b)%type.

Axiom right_injections_def :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (a1:a) (s:set b), (is_empty s) ->
  ((right_injections a1 s) = (empty : set (a* b)%type)).

Axiom right_injections_def1 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (a1:a) (s:set b), ~ (is_empty s) ->
  ((right_injections a1 s) =
   (add (a1, choose s) (right_injections a1 (remove (choose s) s)))).

Axiom right_injections_spec :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (a1:a) (s:set b),
  ((cardinal (right_injections a1 s)) = (cardinal s)).

Axiom right_injections_spec1 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (a1:a) (s:set b), forall (a':a), forall (b1:b),
  (mem (a', b1) (right_injections a1 s)) -> (a' = a1).

Axiom right_injections_spec2 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (a1:a) (s:set b), forall (a':a), forall (b1:b),
  (mem (a', b1) (right_injections a1 s)) -> mem b1 s.

Axiom right_injections_spec3 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (a1:a) (s:set b), forall (a':a), forall (b1:b),
  ((a' = a1) /\ (mem b1 s)) -> mem (a', b1) (right_injections a1 s).

Axiom right_injections_spec4 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (a1:a) (s:set b),
  ((right_injections a1 s) = (map (fun (b1:b) => (a1, b1)) s)).

Parameter left_injections:
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b}, (set a) -> b ->
  set (a* b)%type.

Axiom left_injections_def :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s:set a) (b1:b), (is_empty s) ->
  ((left_injections s b1) = (empty : set (a* b)%type)).

Axiom left_injections_def1 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s:set a) (b1:b), ~ (is_empty s) ->
  ((left_injections s b1) =
   (add (choose s, b1) (left_injections (remove (choose s) s) b1))).

Axiom left_injections_spec :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s:set a) (b1:b), forall (a1:a), forall (b':b),
  (mem (a1, b') (left_injections s b1)) -> mem a1 s.

Axiom left_injections_spec1 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s:set a) (b1:b), forall (a1:a), forall (b':b),
  (mem (a1, b') (left_injections s b1)) -> (b' = b1).

Axiom left_injections_spec2 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s:set a) (b1:b), forall (a1:a), forall (b':b),
  ((mem a1 s) /\ (b' = b1)) -> mem (a1, b') (left_injections s b1).

Axiom left_injections_spec3 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s:set a) (b1:b), ((cardinal (left_injections s b1)) = (cardinal s)).

Axiom left_injections_spec4 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s:set a) (b1:b),
  ((left_injections s b1) = (map (fun (a1:a) => (a1, b1)) s)).

Axiom right_injections_l :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (a1:a) (s:set b),
  ((cardinal (right_injections a1 s)) = (cardinal s)).

Axiom right_injections_l1 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (a1:a) (s:set b), forall (a':a), forall (b1:b),
  (mem (a', b1) (right_injections a1 s)) -> (a' = a1).

Axiom right_injections_l2 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (a1:a) (s:set b), forall (a':a), forall (b1:b),
  (mem (a', b1) (right_injections a1 s)) -> mem b1 s.

Axiom right_injections_l3 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (a1:a) (s:set b), forall (a':a), forall (b1:b),
  ((a' = a1) /\ (mem b1 s)) -> mem (a', b1) (right_injections a1 s).

Axiom right_injections_l4 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (a1:a) (s:set b),
  ((right_injections a1 s) = (map (fun (b1:b) => (a1, b1)) s)).

Axiom left_injections_l :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s:set a) (b1:b), forall (a1:a), forall (b':b),
  (mem (a1, b') (left_injections s b1)) -> mem a1 s.

Axiom left_injections_l1 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s:set a) (b1:b), forall (a1:a), forall (b':b),
  (mem (a1, b') (left_injections s b1)) -> (b' = b1).

Axiom left_injections_l2 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s:set a) (b1:b), forall (a1:a), forall (b':b),
  ((mem a1 s) /\ (b' = b1)) -> mem (a1, b') (left_injections s b1).

Axiom left_injections_l3 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s:set a) (b1:b), ((cardinal (left_injections s b1)) = (cardinal s)).

Axiom left_injections_l4 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s:set a) (b1:b),
  ((left_injections s b1) = (map (fun (a1:a) => (a1, b1)) s)).

Axiom disjoint_injections :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s:set a) (b1:b) (c:b), ~ (b1 = c) ->
  is_empty (inter (right_injections b1 s) (right_injections c s)).

Axiom disjoint_injections1 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s:set a) (b1:b) (c:b), ~ (b1 = c) ->
  is_empty (inter (left_injections s b1) (left_injections s c)).

Axiom induction :
  forall {a:Type} {a_WT:WhyType a},
  forall (p:(set a) -> bool) (t:set a),
  (forall (s:set a), (is_empty s) -> ((p s) = true)) ->
  (forall (s:set a), ((p s) = true) -> forall (t1:a), ~ (mem t1 s) ->
   ((p (add t1 s)) = true)) ->
  ((p t) = true).

Axiom cardinal_sum :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a) (s':set a),
  ((cardinal (union s s')) =
   (((cardinal s) + (cardinal s'))%Z - (cardinal (inter s s')))%Z).

Axiom cardinal_sum_empty_inter :
  forall {a:Type} {a_WT:WhyType a},
  forall (s:set a) (s':set a), ((inter s s') = (empty : set a)) ->
  ((cardinal (union s s')) = ((cardinal s) + (cardinal s'))%Z).

Parameter cartesian_product:
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b}, (set a) ->
  (set b) -> set (a* b)%type.

Axiom cartesian_product_spec :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s1:set a) (s2:set b),
  ((cardinal (cartesian_product s1 s2)) = ((cardinal s1) * (cardinal s2))%Z).

Axiom cartesian_product_spec1 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s1:set a) (s2:set b), forall (a1:a), forall (b1:b),
  (mem (a1, b1) (cartesian_product s1 s2)) -> mem a1 s1.

Axiom cartesian_product_spec2 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s1:set a) (s2:set b), forall (a1:a), forall (b1:b),
  (mem (a1, b1) (cartesian_product s1 s2)) -> mem b1 s2.

Axiom cartesian_product_spec3 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s1:set a) (s2:set b), forall (a1:a), forall (b1:b),
  ((mem a1 s1) /\ (mem b1 s2)) -> mem (a1, b1) (cartesian_product s1 s2).

Axiom cartesian_product_spec4 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s1:set a) (s2:set b), forall (o:(a* b)%type),
  (mem o (cartesian_product s1 s2)) -> forall (x:a) (x1:b), (o = (x, x1)) ->
  mem x s1.

Axiom cartesian_product_spec5 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s1:set a) (s2:set b), forall (o:(a* b)%type),
  (mem o (cartesian_product s1 s2)) -> forall (x:a) (x1:b), (o = (x, x1)) ->
  mem x1 s2.

Axiom cartesian_product_spec6 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s1:set a) (s2:set b), forall (o:(a* b)%type),
  (exists x:a, exists x1:b, (o = (x, x1)) /\ ((mem x s1) /\ (mem x1 s2))) ->
  mem o (cartesian_product s1 s2).

(* Why3 assumption *)
Definition commute {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b}
    (o:(a* b)%type) : (b* a)%type :=
  match o with
  | (a1, b1) => (b1, a1)
  end.

Axiom commute_inj :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (a1:a) (a':a) (b1:b) (b':b), ~ (a1 = a') ->
  ~ ((commute (a1, b1)) = (commute (a', b'))).

Axiom commute_inj1 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (a1:a) (a':a) (b1:b) (b':b), ~ (b1 = b') ->
  ~ ((commute (a1, b1)) = (commute (a', b'))).

Axiom commute_inj_gen :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s1:set a) (s2:set b),
  injective (cartesian_product s1 s2) (fun (y0:(a* b)%type) => (commute y0)).

(* Why3 assumption *)
Definition commute_product {a:Type} {a_WT:WhyType a}
    {b:Type} {b_WT:WhyType b} (s1:set a) (s2:set b) : set (b* a)%type :=
  map (fun (y0:(a* b)%type) => (commute y0)) (cartesian_product s1 s2).

Axiom commute_product_spec :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s1:set a) (s2:set b),
  ((commute_product s1 s2) = (cartesian_product s2 s1)).

(* Why3 assumption *)
Definition commute_product_el {a:Type} {a_WT:WhyType a}
    {b:Type} {b_WT:WhyType b} (s1:set a) (s2:set b) : set (b* a)%type :=
  map (fun (y0:(a* b)%type) => (commute y0)) (cartesian_product s1 s2).

Axiom commute_product_el_spec :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s1:set a) (s2:set b), forall (o:(a* b)%type), forall (x:a) (x1:b),
  (o = (x, x1)) -> (mem o (cartesian_product s1 s2)) -> mem x s1.

Axiom commute_product_el_spec1 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s1:set a) (s2:set b), forall (o:(a* b)%type), forall (x:a) (x1:b),
  (o = (x, x1)) -> (mem o (cartesian_product s1 s2)) -> mem x1 s2.

Axiom commute_product_el_spec2 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s1:set a) (s2:set b), forall (o:(a* b)%type), forall (x:a) (x1:b),
  (o = (x, x1)) -> ((mem x s1) /\ (mem x1 s2)) ->
  mem o (cartesian_product s1 s2).

Axiom commute_product_el_spec3 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s1:set a) (s2:set b), forall (o:(a* b)%type), forall (x:a) (x1:b),
  (o = (x, x1)) -> ((mem x s1) /\ (mem x1 s2)) ->
  mem (x1, x) (commute_product_el s1 s2).

Axiom commute_product_el_spec4 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s1:set a) (s2:set b), forall (o:(a* b)%type), forall (x:a) (x1:b),
  (o = (x, x1)) -> (mem (x1, x) (commute_product_el s1 s2)) -> mem x s1.

Axiom commute_product_el_spec5 :
  forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (s1:set a) (s2:set b), forall (o:(a* b)%type), forall (x:a) (x1:b),
  (o = (x, x1)) -> (mem (x1, x) (commute_product_el s1 s2)) -> mem x1 s2.

Axiom a : Type.
Parameter a_WhyType : WhyType a.
Existing Instance a_WhyType.

Axiom b : Type.
Parameter b_WhyType : WhyType b.
Existing Instance b_WhyType.

Parameter s1: set a.

Parameter s2: set b.

Parameter s3: set b.

Parameter o: (a* b)%type.

Axiom H : forall (x:a) (x1:b), (o = (x, x1)) -> mem x s1.

Axiom H1 : forall (x:a) (x1:b), (o = (x, x1)) -> mem x1 (union s2 s3).

Axiom Hinst :
  ((cardinal (cartesian_product s1 (union s2 s3))) =
   ((cardinal s1) * (cardinal (union s2 s3)))%Z).

Axiom Hinst1 :
  forall (a1:a), forall (b1:b),
  (mem (a1, b1) (cartesian_product s1 (union s2 s3))) -> mem a1 s1.

Axiom Hinst2 :
  forall (a1:a), forall (b1:b),
  (mem (a1, b1) (cartesian_product s1 (union s2 s3))) -> mem b1 (union s2 s3).

Axiom Hinst3 :
  forall (a1:a), forall (b1:b), ((mem a1 s1) /\ (mem b1 (union s2 s3))) ->
  mem (a1, b1) (cartesian_product s1 (union s2 s3)).

Axiom Hinst4 :
  forall (o1:(a* b)%type), (mem o1 (cartesian_product s1 (union s2 s3))) ->
  forall (x:a) (x1:b), (o1 = (x, x1)) -> mem x s1.

Axiom Hinst5 :
  forall (o1:(a* b)%type), (mem o1 (cartesian_product s1 (union s2 s3))) ->
  forall (x:a) (x1:b), (o1 = (x, x1)) -> mem x1 (union s2 s3).

Axiom Hinst6 :
  forall (o1:(a* b)%type),
  (exists x:a, exists x1:b,
   (o1 = (x, x1)) /\ ((mem x s1) /\ (mem x1 (union s2 s3)))) ->
  mem o1 (cartesian_product s1 (union s2 s3)).

(* Why3 goal *)
Theorem h : exists x:a, exists x1:b, ((x, x1) = o).
Proof.

Qed.


(* 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                                                     *)

Require Export trigo.
Set Implicit Arguments.
Unset Strict Implicit.
Parameters (O : PO) (I : PO) (J : PO).
Axiom OIJ : repere_orthonormal_direct O I J.
#[export] Hint Resolve OIJ: geo.

Lemma OIJ_repere_ortho : repere_orthonormal O I J.
auto with geo.
Qed.

Lemma OIJ_repere : repere O I J.
auto with geo.
Qed.

Lemma OI_distincts : O <> I.
elim OIJ; intros.
auto with geo.
elim H0; intros; auto with geo.
Qed.

Lemma OJ_distincts : O <> J.
elim OIJ; intros.
elim H0; intros; auto with geo.
Qed.
#[export] Hint Resolve OIJ_repere_ortho OIJ_repere OI_distincts OJ_distincts: geo.

Lemma IJ_distincts : I <> J.
cut (repere_orthonormal O I J); intros; auto with geo.
elim H; intros.
apply non_alignes_distincts2 with O; auto.
apply orthogonal_non_alignes; auto with geo.
Qed.
#[export] Hint Resolve IJ_distincts: geo.
Parameter C : Type.
Parameter affixe : PO -> C.
Parameter image : C -> PO.
Parameter affixe_vec : PP -> C.
Parameter image_vec : C -> PP.

Axiom affixe_image : forall (z : C) (M : PO), M = image z -> z = affixe M.

Axiom image_affixe : forall (z : C) (M : PO), z = affixe M -> M = image z.

Axiom existence_image_complexe : forall z : C, exists M : PO, M = image z.

Axiom existence_affixe_point : forall M : PO, exists z : C, z = affixe M.

Axiom
  affixe_point_vecteur :
    forall (z : C) (M : PO), z = affixe M -> z = affixe_vec (vec O M).

Axiom
  affixe_vecteur_point :
    forall (z : C) (M : PO), z = affixe_vec (vec O M) -> z = affixe M.

Axiom
  image_point_vecteur :
    forall (z : C) (M : PO), M = image z -> vec O M = image_vec z.

Axiom
  image_vecteur_point :
    forall (z : C) (M : PO), vec O M = image_vec z -> M = image z.
#[export] Hint Resolve image_affixe affixe_image affixe_point_vecteur
  affixe_vecteur_point image_point_vecteur image_vecteur_point: geo.

Lemma affixe_image_vecteur :
 forall (z : C) (M : PO), vec O M = image_vec z -> z = affixe_vec (vec O M).
intros; eauto with geo.
Qed.

Lemma image_affixe_vecteur :
 forall (z : C) (M : PO), z = affixe_vec (vec O M) -> vec O M = image_vec z.
intros; eauto with geo.
Qed.

Lemma existence_image_vecteur_complexe :
 forall z : C, exists M : PO, vec O M = image_vec z.
intros.
elim existence_image_complexe with (z := z); intros M H;
 try clear existence_image_complexe; try exact H.
exists M; eauto with geo.
Qed.

Lemma existence_affixe_vecteur_point :
 forall M : PO, exists z : C, z = affixe_vec (vec O M).
intros.
elim existence_affixe_point with (M := M); intros z H;
 try clear existence_affixe_point; try exact H.
exists z; eauto with geo.
Qed.
Parameter cons_cart : R -> R -> C.

Axiom
  cart_point_complexe :
    forall (z : C) (a b : R) (M : PO),
    vec O M = add_PP (mult_PP a (vec O I)) (mult_PP b (vec O J)) :>PP ->
    z = affixe M -> z = cons_cart a b.

Axiom
  complexe_cart_point :
    forall (z : C) (a b : R) (M : PO),
    z = cons_cart a b ->
    z = affixe M ->
    vec O M = add_PP (mult_PP a (vec O I)) (mult_PP b (vec O J)) :>PP.
#[export] Hint Resolve abscisse_def ordonnee_def cart_def cart_point_complexe
  complexe_cart_point: geo.

Lemma cart_point_complexe2 :
 forall (z : C) (a b : R) (M : PO),
 vec O M = add_PP (mult_PP a (vec O I)) (mult_PP b (vec O J)) :>PP ->
 M = image z -> z = cons_cart a b.
intros.
eauto with geo.
Qed.

Lemma complexe_cart_point2 :
 forall (z : C) (a b : R) (M : PO),
 z = cons_cart a b ->
 M = image z ->
 vec O M = add_PP (mult_PP a (vec O I)) (mult_PP b (vec O J)) :>PP.
intros.
eauto with geo.
Qed.
#[export] Hint Resolve cart_point_complexe2 complexe_cart_point2: geo.

Lemma existence_parties_relles_imaginaires :
 forall z : C, exists a : R, (exists b : R, z = cons_cart a b).
intros.
elim existence_image_complexe with (z := z); intros M H1;
 try clear existence_image_complexe; try exact H1.
elim existence_coordonnees with (O := O) (I := I) (J := J) (M := M);
 [ intros x H2; elim H2; intros y H3 | auto with geo ].
exists x; exists y.
apply (cart_point_complexe (z:=z) (a:=x) (b:=y) (M:=M)); auto with geo.
Qed.

Lemma unicite_parties_relles_imaginaires :
 forall (z : C) (a b a' b' : R),
 z = cons_cart a b -> z = cons_cart a' b' -> a = a' /\ b = b'.
intros.
elim existence_image_complexe with (z := z); intros M H1;
 try clear existence_image_complexe; try exact H1.
apply (unicite_coordonnees (O:=O) (I:=I) (J:=J) (M:=M)); auto with geo.
apply complexe_cart_point with z; auto with geo.
apply complexe_cart_point with z; auto with geo.
Qed.

Lemma egalite_point_image :
 forall (z z' : C) (M M' : PO),
 z = affixe M -> z' = affixe M' -> M = M' -> z = z'.
intros.
elim existence_parties_relles_imaginaires with (z := z); intros a H2; elim H2;
 intros b H3; try clear H2; try exact H3.
elim existence_parties_relles_imaginaires with (z := z'); intros a' H2;
 elim H2; intros b' H4; try clear H2; try exact H4.
generalize (complexe_cart_point (z:=z) (a:=a) (b:=b)); intros H2.
cut (vec O M = add_PP (mult_PP a (vec O I)) (mult_PP b (vec O J))); intros;
 auto.
cut (vec O M = add_PP (mult_PP a' (vec O I)) (mult_PP b' (vec O J))); intros.
elim
 unicite_composantes_vecteur
  with
    (a1 := a)
    (a2 := b)
    (b1 := a')
    (b2 := b')
    (O := O)
    (I := I)
    (J := J)
    (A := O)
    (B := M);
 [ intros H7 H8; try clear unicite_composantes_vecteur; try exact H8
 | auto with geo
 | auto
 | auto ].
rewrite H3; rewrite H4; rewrite H7; rewrite H8; auto.
rewrite H1.
apply complexe_cart_point with z'; auto.
Qed.

Lemma egalite_affixe_point :
 forall (z z' : C) (M M' : PO),
 z = affixe M -> z' = affixe M' -> z = z' -> M = M'.
intros.
elim existence_parties_relles_imaginaires with (z := z); intros a H2; elim H2;
 intros b H3; try clear H2; try exact H3.
elim existence_parties_relles_imaginaires with (z := z'); intros a' H2;
 elim H2; intros b' H4; try clear H2; try exact H4.
generalize (complexe_cart_point (z:=z) (a:=a) (b:=b)); intros H2.
cut (vec O M = add_PP (mult_PP a (vec O I)) (mult_PP b (vec O J))); intros;
 auto.
cut (vec O M' = add_PP (mult_PP a' (vec O I)) (mult_PP b' (vec O J))); intros.
apply vecteur_nul_conf.
replace (vec M M') with (add_PP (vec O M') (mult_PP (-1) (vec O M)));
 [ idtac | Ringvec ].
elim
 unicite_parties_relles_imaginaires
  with (z := z) (a := a) (b := b) (a' := a') (b' := b');
 [ intros; try exact H8 | auto | auto ].
rewrite H5; rewrite H6; rewrite H7; rewrite H8.
Ringvec.
rewrite H1; auto.
apply complexe_cart_point with z'; auto.
Qed.

Lemma egalite_affixe : forall z z' : C, image z = image z' -> z = z'.
intros.
elim existence_image_complexe with (z := z); intros M H0; try exact H0.
elim existence_image_complexe with (z := z'); intros M'; intros.
apply egalite_point_image with (M := M) (M' := M'); auto with geo.
rewrite H0; rewrite H1; auto.
Qed.


(* (c) Copyright 2006-2018 Microsoft Corporation and Inria.                  *)
(* Distributed under the terms of CeCILL-B.                                  *)
From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat seq.
From fourcolor Require Import cfmap cfreducible configurations.

(******************************************************************************)
(* Reducibility of configurations number 315 to 318, whose indices in         *)
(* the_configs range over segment [314, 318).                                 *)
(******************************************************************************)

Lemma red314to318 : reducible_in_range 314 318 the_configs.
Proof. CheckReducible. Qed.


Require Import
        Coq.Classes.Morphisms
        CertifiedExtraction.Core
        CertifiedExtraction.Utils.

Definition TelEq {A} ext (T1 T2: Telescope A) :=
  forall st, st ≲ T1 ∪ ext <->
        st ≲ T2 ∪ ext.

Definition PointWise_TelEq {av T} ext v t1 t2 :=
  forall vv: T, v ↝ vv -> @TelEq av ext (t1 vv) (t2 vv).

Ltac TelEq_rel_t :=
  red; unfold TelEq; intuition;
  repeat match goal with
         | [ H: forall _, _ <-> _ |- _ ] => rewrite H
         | [ H: forall _, _ <-> _, H': _ |- _ ] => rewrite H in H'
         | _ => solve [intuition]
         end.

Require Import Coq.Setoids.Setoid.

Lemma TelEq_refl {A ext}:
  Reflexive (@TelEq A ext).
Proof.
  TelEq_rel_t.
Qed.

Lemma TelEq_sym {A ext}:
  Symmetric (@TelEq A ext).
Proof.
  TelEq_rel_t.
Qed.

Lemma TelEq_trans {A ext}:
  Transitive (@TelEq A ext).
Proof.
  TelEq_rel_t.
Qed.

Add Parametric Relation {A} ext : _ (@TelEq A ext)
    reflexivity proved by TelEq_refl
    symmetry proved by TelEq_sym
    transitivity proved by TelEq_trans
      as TelEqRel.

Add Parametric Morphism {A} ext : (@SameValues A ext)
    with signature (eq ==> (TelEq ext) ==> iff)
      as SameValues_TelEq_morphism.
Proof.
  TelEq_rel_t.
Qed.

Fixpoint NotInTelescope {av} k (tenv: Telescope av) :=
  match tenv with
  | Nil => True
  | Cons _ key val tail => Some k <> (NameTagAsStringOption key) /\ (forall v, val ↝ v -> NotInTelescope k (tail v))
  end.

Lemma NotInTelescope_not_eq_head:
  forall `{FacadeWrapper (Value av) A} (key : string) (val : Comp A)
    (tail : A -> Telescope av) (var : StringMap.key),
    NotInTelescope var ([[` key ~~> val as kk]]::tail kk) ->
    key <> var.
Proof.
  simpl; intros; repeat cleanup; eauto.
Qed.

Lemma NotInTelescope_not_in_tail:
  forall {av A} s (val : Comp A)
    (tail : A -> Telescope av) (var : StringMap.key)
    (v : A),
    val ↝ v ->
    NotInTelescope var ([[ s ~~> val as kk]]::tail kk) ->
    NotInTelescope var (tail v).
Proof.
  simpl; intros.
  intuition eauto.
Qed.

Ltac decide_NotInTelescope :=
  progress repeat match goal with
                  | _ => cleanup
                  | _ => congruence
                  | [  |- NotInTelescope _ Nil ] => reflexivity
                  | [  |- NotInTelescope ?k (Cons _ _ _) ] => unfold NotInTelescope; fold @NotInTelescope
                  end.

Fixpoint DropName {A} k (t: Telescope A) :=
  match t with
  | Nil => Nil
  | Cons T key val tail => Cons (match key with
                                | NTSome _key H => if string_dec _key k then NTNone else key
                                | NTNone => key
                                end) val (fun v => (DropName k (tail v)))
  end.

Definition LiftPropertyToTelescope {av} ext (property: _ -> Prop) : Telescope av -> Prop :=
  fun tenv => forall st, st ≲ tenv ∪ ext -> property st.

Definition Lifted_not_mapsto_adt {av} ext tenv k :=
  @LiftPropertyToTelescope av ext (fun map => not_mapsto_adt k map = true) tenv.

Definition Lifted_MapsTo {av} ext tenv k v :=
  @LiftPropertyToTelescope av ext (StringMap.MapsTo k v) tenv.

Definition Lifted_is_true {av} ext tenv test :=
  @LiftPropertyToTelescope av ext (fun st => is_true st test) tenv.

Definition Lifted_is_false {av} ext tenv test :=
  @LiftPropertyToTelescope av ext (fun st => is_false st test) tenv.

Ltac LiftPropertyToTelescope_t :=
  match goal with
  | [ H: LiftPropertyToTelescope ?ext _ ?tenv, H': ?st ≲ ?tenv ∪ ?ext |- _ ] => learn (H st H')
  | [ H: context[@Lifted_not_mapsto_adt] |- _ ] => unfold Lifted_not_mapsto_adt in H
  | [ H: context[@Lifted_MapsTo] |- _ ] => unfold Lifted_MapsTo in H
  | [ H: context[@Lifted_is_true] |- _ ] => unfold Lifted_is_true in H
  | [ H: context[@Lifted_is_false] |- _ ] => unfold Lifted_is_false in H
  end.

Ltac Lift_morphism_t :=
  match goal with
  | _ => cleanup
  | [ H: forall _, _ -> _, H': _ |- _ ] => learn (H _ H')
  | [ H: forall _, _ <-> _ |- _ ] => rewrite H
  | [ H: forall _, _ <-> _, H': _ |- _ ] => setoid_rewrite H in H'
  end.

Add Parametric Morphism {A} ext : (@LiftPropertyToTelescope A ext)
    with signature (pointwise_relation _ iff ==> TelEq ext ==> iff)
      as LiftPropertyToTelescope_TelEq_morphism.
Proof.
  unfold LiftPropertyToTelescope, pointwise_relation;
  repeat match goal with
         | _ => Lift_morphism_t
         | [ H': TelEq ?ext ?t1 _ |- context[_ ≲ ?t1 ∪ ?ext] ]        => setoid_rewrite H'
         | [ H': TelEq ?ext ?t1 _,  H: context[_ ≲ ?t1 ∪ ?ext] |- _ ] => setoid_rewrite H' in H
         end.
Qed.

Add Parametric Morphism {A} ext : (@Lifted_not_mapsto_adt A ext)
    with signature (TelEq ext ==> eq ==> iff)
      as Lifted_not_mapsto_adt_TelEq_morphism.
Proof.
  eauto using LiftPropertyToTelescope_TelEq_morphism with typeclass_instances.
Qed.

Add Parametric Morphism {A} ext : (@Lifted_MapsTo A ext)
    with signature (TelEq ext ==> eq ==> eq ==> iff)
      as Lifted_MapsTo_TelEq_morphism.
Proof.
  eauto using LiftPropertyToTelescope_TelEq_morphism with typeclass_instances.
Qed.

Add Parametric Morphism {A} ext : (@Lifted_is_true A ext)
    with signature (TelEq ext ==> eq ==> iff)
      as Lifted_is_true_TelEq_morphism.
Proof.
  eauto using LiftPropertyToTelescope_TelEq_morphism with typeclass_instances.
Qed.

Add Parametric Morphism {A} ext : (@Lifted_is_false A ext)
    with signature (TelEq ext ==> eq ==> iff)
      as Lifted_is_false_TelEq_morphism.
Proof.
  eauto using LiftPropertyToTelescope_TelEq_morphism with typeclass_instances.
Qed.

Inductive TelStrongEq {av} : (Telescope av) -> (Telescope av) -> Prop :=
| StrongEqNil : TelStrongEq Nil Nil
| StrongEqCons : forall {A} k (v1 v2: Comp A) t1 t2,
    Monad.equiv v1 v2 ->
    (forall vv, v1 ↝ vv -> TelStrongEq (t1 vv) (t2 vv)) ->
    TelStrongEq (@Cons av A k v1 t1) (@Cons av A k v2 t2).

Ltac inversion' H :=
  inversion H; subst; clear H.

Require Import Eqdep.

Ltac TelStrongEq_t :=
  match goal with
  | [ H: Monad.equiv ?b _ |- ?b ↝ ?B ] => apply (proj2 (H B))
  | [ H: Monad.equiv ?a _, H': ?a ↝ _ |- _ ] => learn (proj1 (H _) H')
  | [ H: Monad.equiv _ ?a, H': ?a ↝ _ |- _ ] => learn (proj2 (H _) H')
  | [ H: TelStrongEq _ _ |- _ ] => first [ inversion' H; fail | inversion' H; [idtac] ]
  | [ H: existT ?P ?x _ = existT ?P ?x _ |- _ ] => apply inj_pair2 in H; subst
  end.

Ltac TelStrongEq_morphism_t :=
  repeat match goal with
         | _ => constructor
         | _ => progress intros
         | _ => TelStrongEq_t
         | _ => eauto with typeclass_instances
         end.

Lemma TelStrongEq_refl {A} :
  Reflexive (@TelStrongEq A).
Proof.
  red; intros tel; induction tel; TelStrongEq_morphism_t.
Qed.

Lemma TelStrongEq_sym {A} :
  Symmetric (@TelStrongEq A).
Proof.
  red; intros tel tel' eq; induction eq;
  TelStrongEq_morphism_t.
Qed.

(* Fixpoint Telescope_code {av} (t1 t2: Telescope av) : Prop := *)
(*   match t1, t2 with *)
(*   | Nil, Nil => True *)
(*   | Nil, _ => False *)
(*   | _, Nil => False *)
(*   | Cons T H key val tail, Cons T' H' key' val' tail' =>  *)
(*     exists (eqT: T = T'), (match eqT in _ = T' return FacadeWrapper _ T' *)
(*                       with eq_refl => H end = H') /\ key = key' *)
(*                      /\ Monad.equiv (match eqT in _ = T' return Comp T' *)
(*                                     with eq_refl => val end) val' *)
(*                      /\ (forall vv, val ↝ vv -> Telescope_code (tail vv) *)
(*                                                         (tail' (match eqT in _ = T' return T' *)
(*                                                                 with eq_refl => vv end))) *)
(*   end. *)

Lemma TelStrongEq_trans {A} :
  Transitive (@TelStrongEq A).
Proof.
  red; intros tel; induction tel;
    TelStrongEq_morphism_t.
Qed.

Add Parametric Relation {A} : _ (@TelStrongEq A)
    reflexivity proved by TelStrongEq_refl
    symmetry proved by TelStrongEq_sym
    transitivity proved by TelStrongEq_trans
      as TelStrongEqRel.

Add Parametric Morphism {av T} : (@Cons av T)
    with signature (eq ==> Monad.equiv ==> pointwise_relation _ (TelStrongEq) ==> (TelStrongEq))
      as Cons_MonadEquiv_TelStrongEq_morphism.
Proof.
  unfold pointwise_relation; intros.
  constructor; eauto.
Qed.

Lemma Propagate_ret :
  forall {av A} k (v: A) (tail: A -> Telescope av),
    TelStrongEq
      (Cons k (ret v) tail)
      (Cons k (ret v) (fun _ => tail v)).
Proof.
  constructor.
  - reflexivity.
  - intros; computes_to_inv; subst; reflexivity.
Qed.


(* (c) Copyright 2006-2018 Microsoft Corporation and Inria.                  *)
(* Distributed under the terms of CeCILL-B.                                  *)
From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat seq.
From fourcolor Require Import cfmap cfreducible configurations.

(******************************************************************************)
(* Reducibility of configurations number 495 to 498, whose indices in         *)
(* the_configs range over segment [494, 498).                                 *)
(******************************************************************************)

Lemma red494to498 : reducible_in_range 494 498 the_configs.
Proof. CheckReducible. Qed.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable wd_ : Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.

Variable col_swap1_1 : (forall A B C : Universe, (col_ A B C -> col_ B A C)).
Variable col_swap2_2 : (forall A B C : Universe, (col_ A B C -> col_ B C A)).
Variable col_triv_3 : (forall A B : Universe, col_ A B B).
Variable wd_swap_4 : (forall A B : Universe, (wd_ A B -> wd_ B A)).
Variable col_trans_5 : (forall P Q A B C : Universe, ((wd_ P Q /\ (col_ P Q A /\ (col_ P Q B /\ col_ P Q C))) -> col_ A B C)).

Theorem pipo_6 : (forall A B C Y P Z Q Qprime Cprime X : Universe, ((wd_ A Y /\ (wd_ P Y /\ (wd_ Q Y /\ (wd_ A B /\ (wd_ B C /\ (wd_ A C /\ (wd_ P Q /\ (wd_ A Z /\ (wd_ B Y /\ (wd_ Y Qprime /\ (wd_ Qprime Cprime /\ (wd_ Y Z /\ (wd_ Z X /\ (wd_ C Y /\ (wd_ P C /\ (wd_ Y Cprime /\ (col_ P Y Q /\ (col_ P Y C /\ (col_ P Q C /\ (col_ Y Q C /\ (col_ A Y B /\ (col_ A Y Z /\ (col_ A B Z /\ (col_ Z Y X /\ (col_ Qprime Y Cprime /\ (col_ Q Z Qprime /\ col_ X C Cprime)))))))))))))))))))))))))) -> col_ Y B Z)).
Proof.
  time tac.
Qed.

End FOFProblem.


Load LFindLoad.
From lfind Require Import LFind.
From QuickChick Require Import QuickChick.
From adtind Require Import goal33.

Derive Show for natural.

              Derive Arbitrary for natural.

              Instance Dec_Eq_natural : Dec_Eq natural.

              Proof. dec_eq. Qed.

Lemma conj19synthconj3 : forall  (lv0 : natural) (lv1 : natural) (lv2 : natural) (lv3 : natural), (@eq natural (Succ (plus (plus lv0 lv1) lv2)) (plus (mult lv2 lv3) lv3)).
Admitted.
QuickChick conj19synthconj3.


(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)
(* Test le Hint Unfold sur des var locales *)

Section toto.
Let EQ := @eq.
Goal EQ nat 0 0.
Hint Unfold EQ.
auto.
Qed.

(* Check regular failure when statically existing ref does not exist
   any longer at run time *)

Goal let x := 0 in True.
intro x.
Fail (clear x; unfold x).
Abort.


(** * Variable Sets *)

Set Implicit Arguments.

Require Import decidable_In.
Require Import extralibrary.
Require Import sublist.
Require Import language_syntax.

(** Subcontext relation *)

Notation sub_ctx := incl.

(** Being-in-a-context relation *)

(** Relation between context and contants *)

Lemma In_oc_sub (A:formula nil) (Ga:context) :
  A @ Ga ->
  sub_name (oc_f A) (oc_c Ga).
Proof.
  unfold sublist; induction Ga as [ | B]; simpl; intros; auto.
  destruct H; subst; auto with datatypes.
Qed.

Implicit Arguments In_oc_sub [A Ga].

Lemma sub_ctx_oc : forall (Ga De:context),
  sub_ctx Ga De -> sub_name (oc_c Ga) (oc_c De).
Proof.
  unfold sublist; intros; induction Ga as [ | A]; simpl in * ; intros; intuition.
  apply in_app_or in H0; destruct H0; auto with datatypes.
  generalize (H A); intros.
  apply In_oc_sub in H1; auto.
Qed.

Hint Resolve In_oc_sub sub_ctx_oc.

(** Relation between variables and traces

 - Traces contain free occurrences of variables in pseudo-terms and -formulae.

 - Well-defined terms or formulas have no local variables. *)

Lemma sub_ov_term : forall m (t:term m),
  sub_name (ov_t t) m.
Proof.
  unfold sublist; induction t; simpl; intros; try case_var; intuition; subst; auto.
  apply in_app_or in H; destruct H; auto with datatypes.
Qed.

Lemma sub_ov_fml : forall m (A:formula m),
  sub_name (ov_f A) m.
Proof.
  unfold sublist; induction A as [ m [p t] | |]; simpl; intros.

  apply sub_ov_term with t; assumption.

  apply in_app_or in H; destruct H; auto.

  apply (@neq_In_cons _ m x a); auto with datatypes.
  - apply (@In_rm_neq name (name_Dec)) in H; auto.
  - apply IHA; auto with datatypes; apply (@In_rm_1 name (name_Dec)) in H; auto.
Qed.

Hint Resolve sub_ov_term sub_ov_fml.

Lemma term_ov_nil_1 : forall (t: term nil),
  ov_t t = nil.
Proof.
  intro t; apply incl_nil; auto.
Qed.

Hint Rewrite -> term_ov_nil_1 : bv.

Lemma term_ov_nil_2 : forall (t:term nil)(x:name),
  x # (ov_t t).
Proof.
intros; rewrite term_ov_nil_1; firstorder.
Qed.

Lemma term_sub : forall (t:term nil) m,
  sub_name (ov_t t) m.
Proof.
intros.
exact (eq_rect_r (fun l => incl l m) (nil_incl m) (term_ov_nil_1 t)).
Qed.

Hint Resolve term_ov_nil_1 term_ov_nil_2 term_sub.

Lemma fml_ov_nil_1 : forall (A:formula nil),
  ov_f A = nil.
Proof.
intro A; eapply incl_nil; eauto.
Qed.

Hint Rewrite -> fml_ov_nil_1 : bv.

Lemma fml_ov_nil_2 : forall (A:formula nil) m,
  sub_name (ov_f A) m.
Proof.
intros; rewrite fml_ov_nil_1; apply nil_incl.
Qed.

Lemma fml_ov_nil_3 : forall (A:formula nil)(x:name),
  x # (ov_f A).
Proof.
intros; rewrite fml_ov_nil_1; firstorder.
Qed.

Hint Resolve fml_ov_nil_1 fml_ov_nil_2 fml_ov_nil_3.

(** inversion properties for variable sets:

   - These properties are used in the definition of substitution. *)

Lemma sub_ov_funL : forall (f:function) m (t0 t1: term m) l,
  sub_name (ov_t (App f t0 t1)) l ->
  sub_name (ov_t t0) l.
Proof.
simpl; intros; eauto 2 with datatypes.
Qed.

Lemma sub_ov_funR : forall (f:function) m (t0 t1: term m) l,
  sub_name (ov_t (App f t0 t1)) l ->
  sub_name (ov_t t1) l.
Proof.
simpl; intros; eauto 2 with datatypes.
Qed.

Hint Resolve sub_ov_funL sub_ov_funR.

Lemma In_inv_atom : forall (p:predicate) m l (t: term m),
  sub_name (ov_f (Atom (p,t))) l ->
  sub_name (ov_t t) l.
Proof.
intros; auto.
Qed.

Lemma In_inv_impL : forall m l (B C: formula m),
  sub_name (ov_f (B --> C)) l ->
  sub_name (ov_f B) l.
Proof.
  simpl; intros; eauto 2 with datatypes.
Qed.

Lemma In_inv_impR : forall m l (B C: formula m),
  sub_name (ov_f (B --> C)) l ->
  sub_name (ov_f C) l.
Proof.
  simpl; intros; eauto 2 with datatypes.
Qed.

Lemma In_inv_all : forall m l x (B:formula (x::m)),
  sub_name (ov_f (@Forall m x B)) l ->
  sub_name (@ov_f (x::m) B) (x::l).
Proof.
  simpl; intros. apply (@incl_rm_2 name (name_Dec)); auto.
Qed.

Hint Resolve In_inv_atom In_inv_impL In_inv_impR In_inv_all.