Require Import UFO.Rel.Definitions.
Require Import UFO.Lang.BindingsFacts.
Require Import UFO.Lang.Xs.
Require Import UFO.Lang.Sim.
Require Import UFO.Lang.OperationalFacts.
Require Import UFO.Lang.SimFacts.

Section section_𝓞_is_adequate.

Lemma 𝓞_left_is_not_stuck n :
∀ ξ₁ ξ₂ t₁ t₂,
n ⊨ 𝓞 ξ₁ ξ₂ t₁ t₂ →
(∃ v₁ : val0, t₁ = v₁) ∨
(∃ ξ₁' t₁', step ⟨ξ₁, t₁⟩ ⟨ξ₁', t₁'⟩).
Proof.
induction n ; intros ξ₁ ξ₂ t₁ t₂ Ot.
+ apply 𝓞_unroll in Ot.
  idestruct Ot as Ot Ot.
  - ielim_prop Ot.
    destruct Ot as [ [? ?] [? [? ?]] ].
    left ; eexists ; eassumption.
  - idestruct Ot as ξ₁' Ot ; idestruct Ot as t₁' Ot ;
    idestruct Ot as St₁ Ot_later.
    ielim_prop St₁.
    right ; repeat eexists ; eassumption.
+ eapply (IHn _ _ _ t₂) ; clear IHn.
  apply 𝓞_roll.
  apply 𝓞_unroll in Ot.
  idestruct Ot as Ot Ot.
  - ielim_prop Ot.
    destruct Ot as [ [v₁ ?] [ξ₂' [v₂ ?]] ] ; subst.
    ileft.
    iintro_prop.
    split ; repeat eexists ; eauto.
  - idestruct Ot as ξ₁' Ot ; idestruct Ot as t₁' Ot ;
    idestruct Ot as St₁ Ot_later.
    ielim_prop St₁.
    apply I_valid_elim in Ot_later ; simpl in Ot_later.
    iright.
    repeat ieexists ; isplit.
    * iintro_prop ; eassumption.
    * iintro_later ; assumption.
Qed.

Lemma sim_preserves_𝓞_l_aux n ξ' t' :
n ⊨ ∀ᵢ ξ₁ ξ₂ t₁ t₂,
(LibList.noduplicates ξ₁)ᵢ ⇒ (LibList.noduplicates ξ₂)ᵢ ⇒
(tm_sim ξ₁ ξ₂ t₁ t₂)ᵢ ⇒ 𝓞 ξ₁ ξ' t₁ t' ⇒ 𝓞 ξ₂ ξ' t₂ t'.
Proof.
loeb_induction.
iintro ξ₁ ; iintro ξ₂ ; iintro t₁ ; iintro t₂.
iintro NoDup_ξ₁ ; iintro NoDup_ξ₂.
iintro Sim ; iintro Obs.
ielim_prop Sim.
apply 𝓞_unroll in Obs ; apply 𝓞_roll.
idestruct Obs as Obs Obs.
+ ileft.
  ielim_prop Obs.
  destruct Obs as [[v₁ ?] [ξ'next [v₂ ?]]] ; subst t₁.
  inversion Sim ; subst ; clear Sim.
  iintro_prop ; eauto.
+ iright.
  idestruct Obs as ξ₁next Obs ; idestruct Obs as t₁next Obs ;
  idestruct Obs as Step₁ Obs.
  ielim_prop Step₁.
  eapply sim_preserves_step in Sim as Step₂ ; eauto.
  destruct Step₂ as [ξ₂next [t₂next Step₂]].
  eapply step_preserves_sim in Step₂ as H ; [
    | exact Step₁ | reflexivity | reflexivity | auto | auto | exact Sim
  ].
  destruct H as [? _].
  repeat ieexists ; isplit.
  - eauto.
  - later_shift.
    ispecialize LöbIH ξ₁next ; ispecialize LöbIH ξ₂next ;
    ispecialize LöbIH t₁next ; ispecialize LöbIH t₂next.
    ispecialize LöbIH ; [ eauto using step_preserves_noduplicates | ].
    ispecialize LöbIH ; [ eauto using step_preserves_noduplicates | ].
    ispecialize LöbIH ; [ eauto | ].
    ispecialize LöbIH ; [ apply Obs | apply LöbIH ].
Qed.

Lemma sim_preserves_𝓞_l n ξ' t' ξ₁ ξ₂ t₁ t₂ :
LibList.noduplicates ξ₁ → LibList.noduplicates ξ₂ → tm_sim ξ₁ ξ₂ t₁ t₂ →
n ⊨ 𝓞 ξ₁ ξ' t₁ t' →
n ⊨ 𝓞 ξ₂ ξ' t₂ t'.
Proof.
specialize (sim_preserves_𝓞_l_aux n ξ' t') as H.
ispecialize H ξ₁ ; ispecialize H ξ₂ ; ispecialize H t₁ ; ispecialize H t₂.
intros.
repeat (ispecialize H ; [ eauto | ]).
assumption.
Qed.

Lemma 𝓞_left_is_sound n cfg cfg' :
  step_n n cfg cfg' →
  ∀ ξ ξ' t t',
  cfg = ⟨ξ, t⟩ →
  cfg' = ⟨ξ', t'⟩ →
  LibList.noduplicates ξ →
  Xs_tm t \c from_list ξ →
  ∀ ζ s,
  n ⊨ 𝓞 ξ ζ t s →
  (∃ v : val0, t' = v) ∨
  (∃ ξ'' t'', step ⟨ξ', t'⟩ ⟨ξ'', t''⟩).
Proof.
induction 1 as [ | n cfg [ξ'' t''] cfg' t_steps t''_steps IH ] ;
intros ξ ξ' t t' Eq_cfg Eq_cfg' NoDupξ Xst ζ s Obs.
+ rewrite Eq_cfg' in Eq_cfg ; inversion Eq_cfg ; subst ξ' t'.
  clear - Obs ; apply 𝓞_unroll in Obs ; unfold 𝓞_Fun in Obs.
  idestruct Obs as Obs Obs.
  - ielim_prop Obs ; crush.
  - idestruct Obs as ξ' Obs ; idestruct Obs as t' Obs ;
    idestruct Obs as t_steps Obs.
    eauto.
+ subst cfg cfg'.
  apply 𝓞_unroll in Obs ; unfold 𝓞_Fun in Obs.
  idestruct Obs as Obs Obs.
  - ielim_prop Obs ; destruct Obs as [ [v ?] [ζ' [u ?]] ].
    subst t.
    inversion t_steps.
  - idestruct Obs as _ξ'' Obs ; idestruct Obs as _t'' Obs ;
    idestruct Obs as _t_steps Obs.
    ielim_prop _t_steps.
    assert (LibList.noduplicates ξ'') as NoDupξ''.
    { eapply step_preserves_noduplicates ; try apply t_steps ; eauto. }
    assert (LibList.noduplicates _ξ'') as NoDup_ξ''.
    { eapply step_preserves_noduplicates ; try apply _t_steps ; eauto. }
    eapply IH ; [
      reflexivity | reflexivity | eassumption |
      eapply (step_preserves_closedness t_steps) ; [reflexivity|reflexivity|exact Xst] |
      clear IH
    ].
    rewrite I_later_shift in Obs.
    eapply sim_preserves_𝓞_l ; [ eassumption | eassumption | | eassumption ].
    eapply step_preserves_sim in t_steps as H ; [
      idtac | exact _t_steps | reflexivity | reflexivity |
      exact NoDupξ | exact NoDupξ | apply tm_sim_refl ; apply Xst
    ].
    destruct H as [H _] ; exact H.
Qed.

Theorem 𝓞_is_adequate n :
∀ ξ₁ ξ₂ t₁ t₂,
n ⊨ 𝓞 ξ₁ ξ₂ t₁ t₂ →
LibList.noduplicates ξ₁ →
Xs_tm t₁ \c from_list ξ₁ →
∀ ξ₁' (v₁ : val0), step_n n ⟨ξ₁, t₁⟩ ⟨ξ₁', v₁⟩ →
∃ ξ₂' (v₂ : val0), step_refl_tran ⟨ξ₂, t₂⟩ ⟨ξ₂', v₂⟩.
Proof.
induction n as [|n] ; intros ? ? ? ? Obs NoDup_ξ₁ Xst ξ₁' v₁ Step_n_t₁.
+ inversion Step_n_t₁ ; subst.
  apply 𝓞_unroll in Obs.
  idestruct Obs as Obs Obs.
  - ielim_prop Obs ; crush.
  - idestruct Obs as ξ₁'' Obs ; idestruct Obs as t₁'' Obs ;
    idestruct Obs as Step_v₁ Obs.
    ielim_prop Step_v₁ ; inversion Step_v₁.
+ inversion Step_n_t₁ as [ | ? ? [ξ₁'' t₁'' ] ? Step_t₁_t₁'' Step_n_t₁'' ] ; subst.
  apply 𝓞_unroll in Obs.
  idestruct Obs as Obs Obs.
  - ielim_prop Obs ; crush.
  - idestruct Obs as ξ₁''' Obs ; idestruct Obs as t₁''' Obs ;
    idestruct Obs as Step_t₁_t₁''' Obs ; ielim_prop Step_t₁_t₁'''.
    apply I_valid_elim in Obs ; simpl in Obs.
    assert (LibList.noduplicates ξ₁'') as NoDup_ξ₁''.
    { eauto using step_preserves_noduplicates. }
    assert (LibList.noduplicates ξ₁''') as NoDup_ξ₁'''.
    { eauto using step_preserves_noduplicates. }
    eapply IHn ; [
      idtac | exact NoDup_ξ₁'' |
      eauto using (step_preserves_closedness Step_t₁_t₁'') | exact Step_n_t₁''
    ].
    eapply sim_preserves_𝓞_l ; [ eassumption | eassumption | | exact Obs ].
    eapply step_preserves_sim in Step_t₁_t₁'' as H ; [
      idtac | exact Step_t₁_t₁''' | reflexivity | reflexivity |
      exact NoDup_ξ₁ | exact NoDup_ξ₁ | auto using tm_sim_refl
    ].
    destruct H as [H _] ; exact H.
Qed.

End section_𝓞_is_adequate.

Section section_logref_is_adequate.

Hint Rewrite dom_empty.
Hint Resolve subset_empty_l.
Hint Unfold step_refl_tran.
Hint Constructors Relation_Operators.clos_refl_trans_1n.

Lemma n_adequacy Ξ ξ₁ ξ₂ (t₁ t₂ : tm0) T n :
  𝜩 Ξ ξ₁ ξ₂ →
  n ⊨ ⟦ Ξ ∅→ ⊢ t₁ ≼ˡᵒᵍ t₂ : T # [] ⟧ →
  n ⊨ 𝓞 ξ₁ ξ₂ t₁ t₂.
Proof.
  intro HΞ.
  intro Ht.
  ispecialize Ht ξ₁ ; ispecialize Ht ξ₂.
  repeat ispecialize Ht (∅→ : ∅ → eff0).
  ispecialize Ht (∅→ : ∅ → IRel 𝓤_Sig).
  repeat ispecialize Ht (∅→ : ∅ → lbl0).
  ispecialize Ht (∅→ : ∅ → IRel 𝓣_Sig).
  repeat ispecialize Ht (∅→ : ∅ → val0).
  ispecialize Ht.
  { iintro_prop ; crush. }
  ispecialize Ht.
  { iintro ; auto. }
  ispecialize Ht.
  { iintro_prop ; split ; crush. }
  ispecialize Ht.
  { iintro ; auto. }
  repeat (erewrite V_bind_tm_id, LV_bind_tm_id, EV_bind_tm_id in Ht ; auto).
  repeat ispecialize Ht (ktx_hole : ktx0).
  iapply Ht.

  isplit.
  + repeat iintro ; simpl.
    apply 𝓞_roll.
    ileft.
    iintro_prop ; split ; repeat eexists ; auto.
  + iintro ξ₁' ; iintro ξ₂' ; iintro Hξ₁' ; iintro Hξ₂' ;
    iintro K₁ ; iintro K₂ ; iintro s₁ ; iintro s₂ ; iintro HKs.
    idestruct HKs as ψ HKs ; idestruct HKs as Xs₁ HKs ; idestruct HKs as Xs₂ HKs.
    idestruct HKs as HFalse HKs.
    icontradict HFalse.
Qed.

Hint Rewrite from_list_nil.

Theorem adequacy t₁ t₂ T :
⊨ ⟦ empty ∅→ ⊢ t₁ ≼ˡᵒᵍ t₂ : T # [] ⟧ →
Xs_tm t₁ = \{} →
∀ ξ₁ (v₁ : val0), step_refl_tran ⟨[], t₁⟩ ⟨ξ₁, v₁⟩ →
∃ ξ₂ (v₂ : val0), step_refl_tran ⟨[], t₂⟩ ⟨ξ₂, v₂⟩.
Proof.
intros Ht Closed_t₁ ξ₁ v₁ Step_t₁.
apply step_refl_tran_to_step_n in Step_t₁.
destruct Step_t₁ as [n Step_t₁].
eapply 𝓞_is_adequate with (ξ₁ := []) ; [ |constructor|crush|exact Step_t₁].
specialize (Ht n).
eapply n_adequacy with (Ξ := empty) ; [split;crush|eauto].
Qed.

End section_logref_is_adequate.


Require Import
        Fiat.Narcissus.Automation.Solver
        Fiat.Narcissus.Common.Specs
        Fiat.Narcissus.Common.Compose
        Fiat.Narcissus.BinLib.Core
        Fiat.Narcissus.ib.FixList
        Fiat.Narcissus.BinLib.FixInt.

Set Implicit Arguments.

Record test_t :=
  { f1 : { n : N | (n < exp2 32)%N };
    f2 : { l : list {n : N | (n < exp2 16)%N} | length l < exp2_nat 16} } .

Instance test_cache : Cache :=
  {| CacheFormat := unit;
     CacheDecode := unit;
     Equiv := fun _ _ => True |}.

Instance test_cache_add_nat : CacheAdd test_cache N :=
  {| addE := fun ce _ => ce;
     addD := fun cd _ => cd;
     add_correct := fun _ _ _ => id |}.

Definition format_test (t : test_t) (ce : CacheFormat) :=
  compose bmonoid (FixInt_format (f1 t)) (
  compose bmonoid (FixInt_format (FixList_getlength (f2 t))) (
  compose bmonoid (FixList_format FixInt_format (f2 t)) (
                       (fun e => (nil, e))))) ce.
(* Commenting out until we update for new framework. *)
(*
Definition test_decoder
  : { decode | format_decode_correct test_cache bmonoid (fun _ => True) format_test decode }.
Proof.
  eexists.
  eapply compose_format_correct. eapply FixInt_format_correct. solve_predicate.
  intro.
  eapply compose_format_correct. eapply FixInt_format_correct. solve_predicate.
  intro.
  eapply compose_format_correct.
  eapply FixList_format_correct.
  eapply FixInt_format_correct.
  solve_predicate.
  intro.
  solve_done.
Defined.

Definition test_decoder'
  : list bool -> CacheDecode -> test_t * list bool * CacheDecode.
Proof.
  let p' := eval cbv delta [ proj1_sig test_decoder ] beta iota in (proj1_sig test_decoder) in
                                                                      pose p' as p.
  exact p.
Defined.
Print test_decoder'. *)


Require Import Events.
Require Import TraceModel.
Require Import Properties.
Require Import CommonST.
Require Import Robustdef.
Require Import ClassicalExtras.

(** This file contains several lemmas that are used in other proofs *)

Lemma list_longest_in_psem {K : language} : forall (P' : prg K) l,
    exists ll, (list_list_prefix ll l) /\ (psem P' (ftbd ll)) /\
          (forall l', list_list_prefix l' l -> psem P' (ftbd l') -> list_list_prefix l' ll).
Proof.
  intros P' l.
  induction l using list_ind_snoc.
  - exists nil; repeat (split; try now auto).
    + destruct (non_empty_sem K P') as [t Ht].
      exists t; split; simpl; auto. now case t.
  - destruct IHl as [ll [Hprefll [Hpsem Hmaxll]]].
    destruct (classic (psem P' (ftbd (snoc l a)))) as [Hsnoc | Hsnoc].
    + exists (snoc l a).  repeat (split; try now auto).
      now apply list_list_prefix_ref.
    + exists ll. repeat (split; try now auto).
      ++ simpl. now apply (list_prefix_snoc_list_prefix ll l a).
      ++ intros l' Hprefl' Hseml'.
         destruct (list_proper_or_equal l' (snoc l a)) as [Hequal | [aa Hproper]]; auto.
         +++ subst. contradiction.
         +++ apply list_pref_snoc_pref in Hproper.
             now apply (Hmaxll l').
Qed.

Lemma  longest_in_psem (tgt_sem : @semantics_safety_like tgt) :
  forall W t, ~ sem tgt W t ->
    exists m, prefix m t /\ psem W m /\
     (forall m', prefix m' t -> psem W m' -> fpr m' m).
Proof.
  intros W [] HsemWt.
  + destruct (list_longest_in_psem W l) as [ll [Hpref [Hpsem Hmax]]].
    exists (ftbd ll). repeat (split; try now auto).
    intros [] Hm Hsem.
    ++ inversion Hm; subst. destruct Hsem as [tm [Hprefmtm Hsemm]].
       destruct tm; inversion Hprefmtm; subst. contradiction.
    ++ simpl in *. apply Hmax; auto.
  + destruct (list_longest_in_psem W l) as [ll [Hpref [Hpsem Hmax]]].
    exists (ftbd ll). repeat (split; try now auto).
    intros [] Hx Hsemx.
    ++ inversion Hx; subst.
    ++ simpl in *. apply Hmax; auto.
  + destruct (tgt_sem (tstream s) W) as [l [ebad [Hseml [Hprefl Hnsem_longer]]]]; auto.
    exists (ftbd l). simpl in *. repeat (split; try now auto).
    ++ apply (list_stream_prefix_trans l (snoc l ebad) s); auto.
       now apply snoc_longer.
    ++ intros [] Hpref_x HxsemW; try now inversion Hpref_x.
       simpl in *. destruct (list_stream_same_ext l0 (snoc l ebad) s); auto.
       * apply list_proper_or_equal in H. destruct H as [H | [a H]].
         ** subst. exfalso. apply Hnsem_longer. destruct HxsemW as [tx [H1 H2]].
                 now exists tx.
         ** now apply list_pref_snoc_pref in H.
       * exfalso. apply Hnsem_longer. destruct HxsemW as [tx [H1 H2]].
             exists tx. split; try now auto.
             destruct tx; simpl in *; try now apply (list_list_prefix_trans (snoc l ebad) l0 l1).
             now apply (list_stream_prefix_trans (snoc l ebad) l0 s0).
Qed.


(* This file is generated by Why3's Coq driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require BuiltIn.
Require HighOrd.
Require bool.Bool.
Require int.Int.
Require int.Abs.
Require int.ComputerDivision.
Require real.Real.
Require real.RealInfix.
Require real.FromInt.
Require map.Map.

Parameter eqb:
  forall {a:Type} {a_WT:WhyType a}, a -> a -> Init.Datatypes.bool.

Axiom eqb1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (y:a), ((eqb x y) = Init.Datatypes.true) <-> (x = y).

Axiom eqb_false :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (y:a), ((eqb x y) = Init.Datatypes.false) <-> ~ (x = y).

Parameter neqb:
  forall {a:Type} {a_WT:WhyType a}, a -> a -> Init.Datatypes.bool.

Axiom neqb1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (y:a), ((neqb x y) = Init.Datatypes.true) <-> ~ (x = y).

Parameter zlt: Numbers.BinNums.Z -> Numbers.BinNums.Z -> Init.Datatypes.bool.

Parameter zleq:
  Numbers.BinNums.Z -> Numbers.BinNums.Z -> Init.Datatypes.bool.

Axiom zlt1 :
  forall (x:Numbers.BinNums.Z) (y:Numbers.BinNums.Z),
  ((zlt x y) = Init.Datatypes.true) <-> (x < y)%Z.

Axiom zleq1 :
  forall (x:Numbers.BinNums.Z) (y:Numbers.BinNums.Z),
  ((zleq x y) = Init.Datatypes.true) <-> (x <= y)%Z.

Parameter rlt:
  Reals.Rdefinitions.R -> Reals.Rdefinitions.R -> Init.Datatypes.bool.

Parameter rleq:
  Reals.Rdefinitions.R -> Reals.Rdefinitions.R -> Init.Datatypes.bool.

Axiom rlt1 :
  forall (x:Reals.Rdefinitions.R) (y:Reals.Rdefinitions.R),
  ((rlt x y) = Init.Datatypes.true) <-> (x < y)%R.

Axiom rleq1 :
  forall (x:Reals.Rdefinitions.R) (y:Reals.Rdefinitions.R),
  ((rleq x y) = Init.Datatypes.true) <-> (x <= y)%R.

(* Why3 assumption *)
Definition real_of_int (x:Numbers.BinNums.Z) : Reals.Rdefinitions.R :=
  BuiltIn.IZR x.

Axiom c_euclidian :
  forall (n:Numbers.BinNums.Z) (d:Numbers.BinNums.Z), ~ (d = 0%Z) ->
  (n = (((ZArith.BinInt.Z.quot n d) * d)%Z + (ZArith.BinInt.Z.rem n d))%Z).

Axiom cmod_remainder :
  forall (n:Numbers.BinNums.Z) (d:Numbers.BinNums.Z),
  ((0%Z <= n)%Z -> (0%Z < d)%Z ->
   (0%Z <= (ZArith.BinInt.Z.rem n d))%Z /\ ((ZArith.BinInt.Z.rem n d) < d)%Z) /\
  ((n <= 0%Z)%Z -> (0%Z < d)%Z ->
   ((-d)%Z < (ZArith.BinInt.Z.rem n d))%Z /\
   ((ZArith.BinInt.Z.rem n d) <= 0%Z)%Z) /\
  ((0%Z <= n)%Z -> (d < 0%Z)%Z ->
   (0%Z <= (ZArith.BinInt.Z.rem n d))%Z /\
   ((ZArith.BinInt.Z.rem n d) < (-d)%Z)%Z) /\
  ((n <= 0%Z)%Z -> (d < 0%Z)%Z ->
   (d < (ZArith.BinInt.Z.rem n d))%Z /\ ((ZArith.BinInt.Z.rem n d) <= 0%Z)%Z).

Axiom cdiv_neutral :
  forall (a:Numbers.BinNums.Z), ((ZArith.BinInt.Z.quot a 1%Z) = a).

Axiom cdiv_inv :
  forall (a:Numbers.BinNums.Z), ~ (a = 0%Z) ->
  ((ZArith.BinInt.Z.quot a a) = 1%Z).

Axiom cdiv_closed_remainder :
  forall (a:Numbers.BinNums.Z) (b:Numbers.BinNums.Z) (n:Numbers.BinNums.Z),
  (0%Z <= a)%Z -> (0%Z <= b)%Z ->
  (0%Z <= (b - a)%Z)%Z /\ ((b - a)%Z < n)%Z ->
  ((ZArith.BinInt.Z.rem a n) = (ZArith.BinInt.Z.rem b n)) -> (a = b).

(* Why3 assumption *)
Inductive addr :=
  | addr'mk : Numbers.BinNums.Z -> Numbers.BinNums.Z -> addr.
Axiom addr_WhyType : WhyType addr.
Existing Instance addr_WhyType.

(* Why3 assumption *)
Definition offset (v:addr) : Numbers.BinNums.Z :=
  match v with
  | addr'mk x x1 => x1
  end.

(* Why3 assumption *)
Definition base (v:addr) : Numbers.BinNums.Z :=
  match v with
  | addr'mk x x1 => x
  end.

Parameter addr_le: addr -> addr -> Prop.

Parameter addr_lt: addr -> addr -> Prop.

Parameter addr_le_bool: addr -> addr -> Init.Datatypes.bool.

Parameter addr_lt_bool: addr -> addr -> Init.Datatypes.bool.

Axiom addr_le_def :
  forall (p:addr) (q:addr), ((base p) = (base q)) ->
  addr_le p q <-> ((offset p) <= (offset q))%Z.

Axiom addr_lt_def :
  forall (p:addr) (q:addr), ((base p) = (base q)) ->
  addr_lt p q <-> ((offset p) < (offset q))%Z.

Axiom addr_le_bool_def :
  forall (p:addr) (q:addr),
  addr_le p q <-> ((addr_le_bool p q) = Init.Datatypes.true).

Axiom addr_lt_bool_def :
  forall (p:addr) (q:addr),
  addr_lt p q <-> ((addr_lt_bool p q) = Init.Datatypes.true).

(* Why3 assumption *)
Definition null : addr := addr'mk 0%Z 0%Z.

(* Why3 assumption *)
Definition global (b:Numbers.BinNums.Z) : addr := addr'mk b 0%Z.

(* Why3 assumption *)
Definition shift (p:addr) (k:Numbers.BinNums.Z) : addr :=
  addr'mk (base p) ((offset p) + k)%Z.

(* Why3 assumption *)
Definition included (p:addr) (a:Numbers.BinNums.Z) (q:addr)
    (b:Numbers.BinNums.Z) : Prop :=
  (0%Z < a)%Z ->
  (0%Z <= b)%Z /\
  ((base p) = (base q)) /\
  ((offset q) <= (offset p))%Z /\
  (((offset p) + a)%Z <= ((offset q) + b)%Z)%Z.

(* Why3 assumption *)
Definition separated (p:addr) (a:Numbers.BinNums.Z) (q:addr)
    (b:Numbers.BinNums.Z) : Prop :=
  (a <= 0%Z)%Z \/
  (b <= 0%Z)%Z \/
  ~ ((base p) = (base q)) \/
  (((offset q) + b)%Z <= (offset p))%Z \/
  (((offset p) + a)%Z <= (offset q))%Z.

(* Why3 assumption *)
Definition eqmem {a:Type} {a_WT:WhyType a} (m1:addr -> a) (m2:addr -> a)
    (p:addr) (a1:Numbers.BinNums.Z) : Prop :=
  forall (q:addr), included q 1%Z p a1 -> ((m1 q) = (m2 q)).

Parameter havoc:
  forall {a:Type} {a_WT:WhyType a}, (addr -> a) -> (addr -> a) -> addr ->
  Numbers.BinNums.Z -> addr -> a.

(* Why3 assumption *)
Definition valid_rw (m:Numbers.BinNums.Z -> Numbers.BinNums.Z) (p:addr)
    (n:Numbers.BinNums.Z) : Prop :=
  (0%Z < n)%Z ->
  (0%Z < (base p))%Z /\
  (0%Z <= (offset p))%Z /\ (((offset p) + n)%Z <= (m (base p)))%Z.

(* Why3 assumption *)
Definition valid_rd (m:Numbers.BinNums.Z -> Numbers.BinNums.Z) (p:addr)
    (n:Numbers.BinNums.Z) : Prop :=
  (0%Z < n)%Z ->
  ~ (0%Z = (base p)) /\
  (0%Z <= (offset p))%Z /\ (((offset p) + n)%Z <= (m (base p)))%Z.

(* Why3 assumption *)
Definition valid_obj (m:Numbers.BinNums.Z -> Numbers.BinNums.Z) (p:addr)
    (n:Numbers.BinNums.Z) : Prop :=
  (0%Z < n)%Z ->
  (p = null) \/
  ~ (0%Z = (base p)) /\
  (0%Z <= (offset p))%Z /\ (((offset p) + n)%Z <= (1%Z + (m (base p)))%Z)%Z.

(* Why3 assumption *)
Definition invalid (m:Numbers.BinNums.Z -> Numbers.BinNums.Z) (p:addr)
    (n:Numbers.BinNums.Z) : Prop :=
  (n <= 0%Z)%Z \/
  ((base p) = 0%Z) \/
  ((m (base p)) <= (offset p))%Z \/ (((offset p) + n)%Z <= 0%Z)%Z.

Axiom valid_rw_rd :
  forall (m:Numbers.BinNums.Z -> Numbers.BinNums.Z), forall (p:addr),
  forall (n:Numbers.BinNums.Z), valid_rw m p n -> valid_rd m p n.

Axiom valid_string :
  forall (m:Numbers.BinNums.Z -> Numbers.BinNums.Z), forall (p:addr),
  ((base p) < 0%Z)%Z ->
  (0%Z <= (offset p))%Z /\ ((offset p) < (m (base p)))%Z ->
  valid_rd m p 1%Z /\ ~ valid_rw m p 1%Z.

Axiom separated_1 :
  forall (p:addr) (q:addr),
  forall (a:Numbers.BinNums.Z) (b:Numbers.BinNums.Z) (i:Numbers.BinNums.Z)
    (j:Numbers.BinNums.Z),
  separated p a q b -> ((offset p) <= i)%Z /\ (i < ((offset p) + a)%Z)%Z ->
  ((offset q) <= j)%Z /\ (j < ((offset q) + b)%Z)%Z ->
  ~ ((addr'mk (base p) i) = (addr'mk (base q) j)).

Parameter region: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter linked: (Numbers.BinNums.Z -> Numbers.BinNums.Z) -> Prop.

Parameter sconst: (addr -> Numbers.BinNums.Z) -> Prop.

(* Why3 assumption *)
Definition framed (m:addr -> addr) : Prop :=
  forall (p:addr), ((region (base p)) <= 0%Z)%Z ->
  ((region (base (m p))) <= 0%Z)%Z.

Axiom separated_included :
  forall (p:addr) (q:addr),
  forall (a:Numbers.BinNums.Z) (b:Numbers.BinNums.Z), (0%Z < a)%Z ->
  (0%Z < b)%Z -> separated p a q b -> ~ included p a q b.

Axiom included_trans :
  forall (p:addr) (q:addr) (r:addr),
  forall (a:Numbers.BinNums.Z) (b:Numbers.BinNums.Z) (c:Numbers.BinNums.Z),
  included p a q b -> included q b r c -> included p a r c.

Axiom separated_trans :
  forall (p:addr) (q:addr) (r:addr),
  forall (a:Numbers.BinNums.Z) (b:Numbers.BinNums.Z) (c:Numbers.BinNums.Z),
  included p a q b -> separated q b r c -> separated p a r c.

Axiom separated_sym :
  forall (p:addr) (q:addr),
  forall (a:Numbers.BinNums.Z) (b:Numbers.BinNums.Z),
  separated p a q b <-> separated q b p a.

Axiom eqmem_included :
  forall {a:Type} {a_WT:WhyType a},
  forall (m1:addr -> a) (m2:addr -> a), forall (p:addr) (q:addr),
  forall (a1:Numbers.BinNums.Z) (b:Numbers.BinNums.Z), included p a1 q b ->
  eqmem m1 m2 q b -> eqmem m1 m2 p a1.

Axiom eqmem_sym :
  forall {a:Type} {a_WT:WhyType a},
  forall (m1:addr -> a) (m2:addr -> a), forall (p:addr),
  forall (a1:Numbers.BinNums.Z), eqmem m1 m2 p a1 -> eqmem m2 m1 p a1.

Axiom havoc_access :
  forall {a:Type} {a_WT:WhyType a},
  forall (m0:addr -> a) (m1:addr -> a), forall (q:addr) (p:addr),
  forall (a1:Numbers.BinNums.Z),
  (separated q 1%Z p a1 -> ((havoc m0 m1 p a1 q) = (m1 q))) /\
  (~ separated q 1%Z p a1 -> ((havoc m0 m1 p a1 q) = (m0 q))).

Parameter cinits: (addr -> Init.Datatypes.bool) -> Prop.

(* Why3 assumption *)
Definition is_init_range (m:addr -> Init.Datatypes.bool) (p:addr)
    (l:Numbers.BinNums.Z) : Prop :=
  forall (i:Numbers.BinNums.Z), (0%Z <= i)%Z /\ (i < l)%Z ->
  ((m (shift p i)) = Init.Datatypes.true).

Parameter set_init:
  (addr -> Init.Datatypes.bool) -> addr -> Numbers.BinNums.Z ->
  addr -> Init.Datatypes.bool.

Axiom set_init_access :
  forall (m:addr -> Init.Datatypes.bool), forall (q:addr) (p:addr),
  forall (a:Numbers.BinNums.Z),
  (separated q 1%Z p a -> ((set_init m p a q) = (m q))) /\
  (~ separated q 1%Z p a -> ((set_init m p a q) = Init.Datatypes.true)).

(* Why3 assumption *)
Definition monotonic_init (m1:addr -> Init.Datatypes.bool)
    (m2:addr -> Init.Datatypes.bool) : Prop :=
  forall (p:addr), ((m1 p) = Init.Datatypes.true) ->
  ((m2 p) = Init.Datatypes.true).

Parameter int_of_addr: addr -> Numbers.BinNums.Z.

Parameter addr_of_int: Numbers.BinNums.Z -> addr.

Axiom table : Type.
Parameter table_WhyType : WhyType table.
Existing Instance table_WhyType.

Parameter table_of_base: Numbers.BinNums.Z -> table.

Parameter table_to_offset: table -> Numbers.BinNums.Z -> Numbers.BinNums.Z.

Axiom table_to_offset_zero :
  forall (t:table), ((table_to_offset t 0%Z) = 0%Z).

Axiom table_to_offset_monotonic :
  forall (t:table), forall (o1:Numbers.BinNums.Z) (o2:Numbers.BinNums.Z),
  (o1 <= o2)%Z <-> ((table_to_offset t o1) <= (table_to_offset t o2))%Z.

Axiom int_of_addr_bijection :
  forall (a:Numbers.BinNums.Z), ((int_of_addr (addr_of_int a)) = a).

Axiom addr_of_int_bijection :
  forall (p:addr), ((addr_of_int (int_of_addr p)) = p).

Axiom addr_of_null : ((int_of_addr null) = 0%Z).

(* Why3 assumption *)
Definition is_bool (x:Numbers.BinNums.Z) : Prop := (x = 0%Z) \/ (x = 1%Z).

(* Why3 assumption *)
Definition is_uint8 (x:Numbers.BinNums.Z) : Prop :=
  (0%Z <= x)%Z /\ (x < 256%Z)%Z.

(* Why3 assumption *)
Definition is_sint8 (x:Numbers.BinNums.Z) : Prop :=
  ((-128%Z)%Z <= x)%Z /\ (x < 128%Z)%Z.

(* Why3 assumption *)
Definition is_uint16 (x:Numbers.BinNums.Z) : Prop :=
  (0%Z <= x)%Z /\ (x < 65536%Z)%Z.

(* Why3 assumption *)
Definition is_sint16 (x:Numbers.BinNums.Z) : Prop :=
  ((-32768%Z)%Z <= x)%Z /\ (x < 32768%Z)%Z.

(* Why3 assumption *)
Definition is_uint32 (x:Numbers.BinNums.Z) : Prop :=
  (0%Z <= x)%Z /\ (x < 4294967296%Z)%Z.

(* Why3 assumption *)
Definition is_sint32 (x:Numbers.BinNums.Z) : Prop :=
  ((-2147483648%Z)%Z <= x)%Z /\ (x < 2147483648%Z)%Z.

(* Why3 assumption *)
Definition is_uint64 (x:Numbers.BinNums.Z) : Prop :=
  (0%Z <= x)%Z /\ (x < 18446744073709551616%Z)%Z.

(* Why3 assumption *)
Definition is_sint64 (x:Numbers.BinNums.Z) : Prop :=
  ((-9223372036854775808%Z)%Z <= x)%Z /\ (x < 9223372036854775808%Z)%Z.

Axiom is_bool0 : is_bool 0%Z.

Axiom is_bool1 : is_bool 1%Z.

Parameter to_bool: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Axiom to_bool'def :
  forall (x:Numbers.BinNums.Z),
  ((x = 0%Z) -> ((to_bool x) = 0%Z)) /\ (~ (x = 0%Z) -> ((to_bool x) = 1%Z)).

Parameter to_uint8: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter to_sint8: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter to_uint16: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter to_sint16: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter to_uint32: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter to_sint32: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter to_uint64: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter to_sint64: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter two_power_abs: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Axiom two_power_abs_is_positive :
  forall (n:Numbers.BinNums.Z), (0%Z < (two_power_abs n))%Z.

Axiom two_power_abs_plus_pos :
  forall (n:Numbers.BinNums.Z) (m:Numbers.BinNums.Z), (0%Z <= n)%Z ->
  (0%Z <= m)%Z ->
  ((two_power_abs (n + m)%Z) = ((two_power_abs n) * (two_power_abs m))%Z).

Axiom two_power_abs_plus_one :
  forall (n:Numbers.BinNums.Z), (0%Z <= n)%Z ->
  ((two_power_abs (n + 1%Z)%Z) = (2%Z * (two_power_abs n))%Z).

(* Why3 assumption *)
Definition is_uint (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z) : Prop :=
  (0%Z <= x)%Z /\ (x < (two_power_abs n))%Z.

(* Why3 assumption *)
Definition is_sint (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z) : Prop :=
  ((-(two_power_abs n))%Z <= x)%Z /\ (x < (two_power_abs n))%Z.

Parameter to_uint:
  Numbers.BinNums.Z -> Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter to_sint:
  Numbers.BinNums.Z -> Numbers.BinNums.Z -> Numbers.BinNums.Z.

Axiom is_to_uint :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z), is_uint n (to_uint n x).

Axiom is_to_sint :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z), is_sint n (to_sint n x).

Axiom is_to_uint8 : forall (x:Numbers.BinNums.Z), is_uint8 (to_uint8 x).

Axiom is_to_sint8 : forall (x:Numbers.BinNums.Z), is_sint8 (to_sint8 x).

Axiom is_to_uint16 : forall (x:Numbers.BinNums.Z), is_uint16 (to_uint16 x).

Axiom is_to_sint16 : forall (x:Numbers.BinNums.Z), is_sint16 (to_sint16 x).

Axiom is_to_uint32 : forall (x:Numbers.BinNums.Z), is_uint32 (to_uint32 x).

Axiom is_to_sint32 : forall (x:Numbers.BinNums.Z), is_sint32 (to_sint32 x).

Axiom is_to_uint64 : forall (x:Numbers.BinNums.Z), is_uint64 (to_uint64 x).

Axiom is_to_sint64 : forall (x:Numbers.BinNums.Z), is_sint64 (to_sint64 x).

Axiom id_uint :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z),
  is_uint n x <-> ((to_uint n x) = x).

Axiom id_sint :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z),
  is_sint n x <-> ((to_sint n x) = x).

Axiom id_uint8 :
  forall (x:Numbers.BinNums.Z), is_uint8 x -> ((to_uint8 x) = x).

Axiom id_sint8 :
  forall (x:Numbers.BinNums.Z), is_sint8 x -> ((to_sint8 x) = x).

Axiom id_uint16 :
  forall (x:Numbers.BinNums.Z), is_uint16 x -> ((to_uint16 x) = x).

Axiom id_sint16 :
  forall (x:Numbers.BinNums.Z), is_sint16 x -> ((to_sint16 x) = x).

Axiom id_uint32 :
  forall (x:Numbers.BinNums.Z), is_uint32 x -> ((to_uint32 x) = x).

Axiom id_sint32 :
  forall (x:Numbers.BinNums.Z), is_sint32 x -> ((to_sint32 x) = x).

Axiom id_uint64 :
  forall (x:Numbers.BinNums.Z), is_uint64 x -> ((to_uint64 x) = x).

Axiom id_sint64 :
  forall (x:Numbers.BinNums.Z), is_sint64 x -> ((to_sint64 x) = x).

Axiom proj_uint :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z),
  ((to_uint n (to_uint n x)) = (to_uint n x)).

Axiom proj_sint :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z),
  ((to_sint n (to_sint n x)) = (to_sint n x)).

Axiom proj_uint8 :
  forall (x:Numbers.BinNums.Z), ((to_uint8 (to_uint8 x)) = (to_uint8 x)).

Axiom proj_sint8 :
  forall (x:Numbers.BinNums.Z), ((to_sint8 (to_sint8 x)) = (to_sint8 x)).

Axiom proj_uint16 :
  forall (x:Numbers.BinNums.Z), ((to_uint16 (to_uint16 x)) = (to_uint16 x)).

Axiom proj_sint16 :
  forall (x:Numbers.BinNums.Z), ((to_sint16 (to_sint16 x)) = (to_sint16 x)).

Axiom proj_uint32 :
  forall (x:Numbers.BinNums.Z), ((to_uint32 (to_uint32 x)) = (to_uint32 x)).

Axiom proj_sint32 :
  forall (x:Numbers.BinNums.Z), ((to_sint32 (to_sint32 x)) = (to_sint32 x)).

Axiom proj_uint64 :
  forall (x:Numbers.BinNums.Z), ((to_uint64 (to_uint64 x)) = (to_uint64 x)).

Axiom proj_sint64 :
  forall (x:Numbers.BinNums.Z), ((to_sint64 (to_sint64 x)) = (to_sint64 x)).

Axiom proj_su :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z),
  ((to_sint n (to_uint n x)) = (to_uint n x)).

Axiom incl_su :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z), is_uint n x ->
  is_sint n x.

Axiom proj_su_uint :
  forall (n:Numbers.BinNums.Z) (m:Numbers.BinNums.Z) (x:Numbers.BinNums.Z),
  (0%Z <= n)%Z -> (0%Z <= m)%Z ->
  ((to_sint (m + n)%Z (to_uint n x)) = (to_uint n x)).

Axiom proj_su_sint :
  forall (n:Numbers.BinNums.Z) (m:Numbers.BinNums.Z) (x:Numbers.BinNums.Z),
  (0%Z <= n)%Z -> (0%Z <= m)%Z ->
  ((to_sint n (to_uint (m + (n + 1%Z)%Z)%Z x)) = (to_sint n x)).

Axiom proj_int8 :
  forall (x:Numbers.BinNums.Z), ((to_sint8 (to_uint8 x)) = (to_sint8 x)).

Axiom proj_int16 :
  forall (x:Numbers.BinNums.Z), ((to_sint16 (to_uint16 x)) = (to_sint16 x)).

Axiom proj_int32 :
  forall (x:Numbers.BinNums.Z), ((to_sint32 (to_uint32 x)) = (to_sint32 x)).

Axiom proj_int64 :
  forall (x:Numbers.BinNums.Z), ((to_sint64 (to_uint64 x)) = (to_sint64 x)).

Axiom proj_us_uint :
  forall (n:Numbers.BinNums.Z) (m:Numbers.BinNums.Z) (x:Numbers.BinNums.Z),
  (0%Z <= n)%Z -> (0%Z <= m)%Z ->
  ((to_uint (n + 1%Z)%Z (to_sint (m + n)%Z x)) = (to_uint (n + 1%Z)%Z x)).

Axiom incl_uint :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z) (i:Numbers.BinNums.Z),
  (0%Z <= n)%Z -> (0%Z <= i)%Z -> is_uint n x -> is_uint (n + i)%Z x.

Axiom incl_sint :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z) (i:Numbers.BinNums.Z),
  (0%Z <= n)%Z -> (0%Z <= i)%Z -> is_sint n x -> is_sint (n + i)%Z x.

Axiom incl_int :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z) (i:Numbers.BinNums.Z),
  (0%Z <= n)%Z -> (0%Z <= i)%Z -> is_uint n x -> is_sint (n + i)%Z x.

(* Why3 assumption *)
Definition is_sint32_chunk (m:addr -> Numbers.BinNums.Z) : Prop :=
  forall (a:addr), is_sint32 (m a).

Parameter L_sum:
  (addr -> Numbers.BinNums.Z) -> addr -> Numbers.BinNums.Z ->
  Numbers.BinNums.Z -> Numbers.BinNums.Z.

Axiom Q_sum2 :
  forall (Mint:addr -> Numbers.BinNums.Z) (t:addr) (i:Numbers.BinNums.Z)
    (j:Numbers.BinNums.Z),
  let x := Mint (shift t j) in
  (i <= j)%Z -> is_sint32_chunk Mint -> is_sint32 x ->
  (((L_sum Mint t i j) + x)%Z = (L_sum Mint t i (1%Z + j)%Z)).

Axiom Q_sum1 :
  forall (Mint:addr -> Numbers.BinNums.Z) (t:addr) (i:Numbers.BinNums.Z)
    (j:Numbers.BinNums.Z),
  (j <= i)%Z -> is_sint32_chunk Mint -> ((L_sum Mint t i j) = 0%Z).

(* Why3 goal *)
Theorem wp_goal :
  forall (t:addr -> Numbers.BinNums.Z) (a:addr) (i:Numbers.BinNums.Z)
    (i1:Numbers.BinNums.Z) (i2:Numbers.BinNums.Z),
  (i1 <= i2)%Z -> (i <= i1)%Z -> (0%Z <= i)%Z -> is_sint32_chunk t ->
  (((L_sum t a i i1) + (L_sum t a i1 i2))%Z = (L_sum t a i i2)).
(* Why3 intros t a i i1 i2 h1 h2 h3 h4. *)
Proof.
intros.
apply Zlt_lower_bound_ind with
(P:= fun k => (L_sum t a i i1 + L_sum t a i1 k)%Z = L_sum t a i k)(z := i1) ;[| Lia.lia].
intros.
assert (H5:(i1 = x \/ i1 < x)%Z) by Lia.lia.
destruct H5.
- rewrite H5.
  rewrite (Q_sum1 _ _ x x).
  rewrite Int.Unit_def_r.
  reflexivity.
  reflexivity.
  assumption.
- replace x with (1 + (x-1))%Z by Lia.lia.
  rewrite <- (Q_sum2 t a i (x -1));[ | Lia.lia| assumption| apply H2].
  rewrite <- (Q_sum2 t a i1 (x -1));[ | Lia.lia| assumption| apply H2].
  rewrite <- (H3 (x-1)%Z) by Lia.lia.
  rewrite Z.add_assoc.
  reflexivity.
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 O E Eprime A B C D Bprime X Bprimeprime Dprime : Universe, ((wd_ C O /\ (wd_ O E /\ (wd_ O Eprime /\ (wd_ E Eprime /\ (wd_ A O /\ (wd_ B O /\ (wd_ D O /\ (wd_ Eprime A /\ (wd_ X O /\ (wd_ D Dprime /\ (wd_ Bprime X /\ (wd_ B Bprime /\ (col_ O E A /\ (col_ O E B /\ (col_ O E C /\ (col_ O E D /\ (col_ O Eprime Bprime /\ (col_ O E X /\ (col_ O Eprime Bprimeprime /\ col_ O Eprime Dprime))))))))))))))))))) -> col_ O X B)).
Proof.
  time tac.
Qed.

End FOFProblem.


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 D P Q R M Dprime E : Universe, ((wd_ A B /\ (wd_ B C /\ (wd_ C D /\ (wd_ P Q /\ (wd_ Q R /\ (wd_ M B /\ (wd_ M C /\ (wd_ D Dprime /\ (wd_ C Dprime /\ (wd_ B D /\ (wd_ C A /\ (col_ M C D /\ (col_ M Dprime E /\ (col_ C D Dprime /\ col_ M B C)))))))))))))) -> col_ B C D)).
Proof.
  time tac.
Qed.

End FOFProblem.