(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
(* Distributed under the terms of CeCILL-B.                                  *)
Require Import mathcomp.ssreflect.ssreflect.
From mathcomp
Require Import ssrbool ssrfun eqtype ssrnat seq path fintype bigop.
From mathcomp
Require Import finset fingroup morphism automorphism quotient action.
From mathcomp
Require Import commutator center.
(******************************************************************************)
(*           H <|<| G   <=> H is subnormal in G, i.e., H <| ... <| G.         *)
(* invariant_factor A H G <=> A normalises both H and G, and H <| G.          *)
(*         A.-invariant <=> the (invariant_factor A) relation, in the context *)
(*                          of the g_rel.-series notation.                    *)
(*    g_rel.-series H s <=> H :: s is a sequence of groups whose projection   *)
(*                          to sets satisfies relation g_rel pairwise; for    *)
(*                          example H <|<| G iff G = last H s for some s such *)
(*                          that normal.-series H s.                          *)
(*   stable_factor A H G == H <| G and A centralises G / H.                   *)
(*             A.-stable == the stable_factor relation, in the scope of the   *)
(*                          r.-series notation.                               *)
(*            G.-central == the central_factor relation, in the scope of the  *)
(*                          r.-series notation.                               *)
(*           maximal M G == M is a maximal proper subgroup of G.              *)
(*        maximal_eq M G == (M == G) or (maximal M G).                        *)
(*       maxnormal M G N == M is a maximal subgroup of G normalized by N.     *)
(*         minnormal M N == M is a minimal nontrivial group normalized by N.  *)
(*              simple G == G is a (nontrivial) simple group.                 *)
(*                       := minnormal G G                                     *)
(*              G.-chief == the chief_factor relation, in the scope of the    *)
(*                          r.-series notation.                               *)
(******************************************************************************)

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Import GroupScope.

Section GroupDefs.

Variable gT : finGroupType.
Implicit Types A B U V : {set gT}.

Local Notation groupT := (group_of (Phant gT)).

Definition subnormal A B :=
  (A \subset B) && (iter #|B| (fun N => generated (class_support A N)) B == A).

Definition invariant_factor A B C :=
  [&& A \subset 'N(B), A \subset 'N(C) & B <| C].

Definition group_rel_of (r : rel {set gT}) := [rel H G : groupT | r H G].

Definition stable_factor A V U :=
  ([~: U, A] \subset V) && (V <| U). (* this orders allows and3P to be used *)

Definition central_factor A V U :=
  [&& [~: U, A] \subset V, V \subset U & U \subset A].

Definition maximal A B := [max A of G | G \proper B].

Definition maximal_eq A B := (A == B) || maximal A B.

Definition maxnormal A B U := [max A of G | G \proper B & U \subset 'N(G)].

Definition minnormal A B := [min A of G | G :!=: 1 & B \subset 'N(G)].

Definition simple A := minnormal A A.

Definition chief_factor A V U := maxnormal V U A && (U <| A).
End GroupDefs.

Arguments subnormal {gT} A%g B%g.
Arguments invariant_factor {gT} A%g B%g C%g.
Arguments stable_factor {gT} A%g V%g U%g.
Arguments central_factor {gT} A%g V%g U%g.
Arguments maximal {gT} A%g B%g.
Arguments maximal_eq {gT} A%g B%g.
Arguments maxnormal {gT} A%g B%g U%g.
Arguments minnormal {gT} A%g B%g.
Arguments simple {gT} A%g.
Arguments chief_factor {gT} A%g V%g U%g.

Notation "H <|<| G" := (subnormal H G)
  (at level 70, no associativity) : group_scope.

Notation "A .-invariant" := (invariant_factor A)
  (at level 2, format "A .-invariant") : group_rel_scope.
Notation "A .-stable" := (stable_factor A)
  (at level 2, format "A .-stable") : group_rel_scope.
Notation "A .-central" := (central_factor A)
  (at level 2, format "A .-central") : group_rel_scope.
Notation "G .-chief" := (chief_factor G)
  (at level 2, format "G .-chief") : group_rel_scope.

Arguments group_rel_of {gT} r%group_rel_scope _%G _%G : extra scopes.

Notation "r .-series" := (path (rel_of_simpl_rel (group_rel_of r)))
  (at level 2, format "r .-series") : group_scope.

Section Subnormal.

Variable gT : finGroupType.
Implicit Types (A B C D : {set gT}) (G H K : {group gT}).

Let setIgr H G := (G :&: H)%G.
Let sub_setIgr G H : G \subset H -> G = setIgr H G.
Proof. by move/setIidPl/group_inj. Qed.

Let path_setIgr H G s :
   normal.-series H s -> normal.-series (setIgr G H) (map (setIgr G) s).
Proof.
elim: s H => //= K s IHs H /andP[/andP[sHK nHK] Ksn].
by rewrite /normal setSI ?normsIG ?IHs.
Qed.

Lemma subnormalP H G :
  reflect (exists2 s, normal.-series H s & last H s = G) (H <|<| G).
Proof.
apply: (iffP andP) => [[sHG snHG] | [s Hsn <-{G}]].
  elim: {G}#|G| {-2}G sHG snHG => [|m IHm] G sHG.
    by exists [::]; last by apply/eqP; rewrite eq_sym.
  rewrite iterSr => /IHm[|s Hsn defG].
    by rewrite sub_gen // class_supportEr (bigD1 1) //= conjsg1 subsetUl.
  exists (rcons s G); rewrite ?last_rcons // -cats1 cat_path Hsn defG /=.
  rewrite /normal gen_subG class_support_subG //=.
  by rewrite norms_gen ?class_support_norm.
set f := fun _ => <<_>>; have idf: iter _ f H == H.
  by elim=> //= m IHm; rewrite (eqP IHm) /f class_support_id genGid.
elim: {s}(size s) {-2}s (eqxx (size s)) Hsn => [[] //= | m IHm s].
case/lastP: s => // s G; rewrite size_rcons last_rcons -cats1 cat_path /=.
set K := last H s => def_m /and3P[Hsn /andP[sKG nKG] _].
have:= sKG; rewrite subEproper; case/predU1P=> [<-|prKG]; first exact: IHm.
pose L := [group of f G].
have sHK: H \subset K by case/IHm: Hsn.
have sLK: L \subset K by rewrite gen_subG class_support_sub_norm.
rewrite -(subnK (proper_card (sub_proper_trans sLK prKG))) iter_add iterSr.
have defH: H = setIgr L H by rewrite -sub_setIgr ?sub_gen ?sub_class_support.
have: normal.-series H (map (setIgr L) s) by rewrite defH path_setIgr.
case/IHm=> [|_]; first by rewrite size_map.
by rewrite {1 2}defH last_map (subset_trans sHK) //= (setIidPr sLK) => /eqP->.
Qed.

Lemma subnormal_refl G : G <|<| G.
Proof. by apply/subnormalP; exists [::]. Qed.

Lemma subnormal_trans K H G : H <|<| K -> K <|<| G -> H <|<| G.
Proof.
case/subnormalP=> [s1 Hs1 <-] /subnormalP[s2 Hs12 <-].
by apply/subnormalP; exists (s1 ++ s2); rewrite ?last_cat // cat_path Hs1.
Qed.

Lemma normal_subnormal H G : H <| G -> H <|<| G.
Proof. by move=> nsHG; apply/subnormalP; exists [:: G]; rewrite //= nsHG. Qed.

Lemma setI_subnormal G H K : K \subset G -> H <|<| G -> H :&: K <|<| K.
Proof.
move=> sKG /subnormalP[s Hs defG]; apply/subnormalP.
exists (map (setIgr K) s); first exact: path_setIgr.
rewrite (last_map (setIgr K)) defG.
by apply: val_inj; rewrite /= (setIidPr sKG).
Qed.

Lemma subnormal_sub G H : H <|<| G -> H \subset G.
Proof. by case/andP. Qed.

Lemma invariant_subnormal A G H :
    A \subset 'N(G) -> A \subset 'N(H) -> H <|<| G ->
  exists2 s, (A.-invariant).-series H s & last H s = G.
Proof.
move=> nGA nHA /andP[]; move: #|G| => m.
elim: m => [|m IHm] in G nGA * => sHG.
  by rewrite eq_sym; exists [::]; last apply/eqP.
rewrite iterSr; set K := <<_>>.
have nKA: A \subset 'N(K) by rewrite norms_gen ?norms_class_support.
have sHK: H \subset K by rewrite sub_gen ?sub_class_support.
case/IHm=> // s Hsn defK; exists (rcons s G); last by rewrite last_rcons.
rewrite rcons_path Hsn !andbA defK nGA nKA /= -/K.
by rewrite gen_subG class_support_subG ?norms_gen ?class_support_norm.
Qed.

Lemma subnormalEsupport G H :
  H <|<| G -> H :=: G \/ <<class_support H G>> \proper G.
Proof.
case/andP=> sHG; set K := <<_>> => /eqP <-.
have: K \subset G by rewrite gen_subG class_support_subG.
rewrite subEproper; case/predU1P=> [defK|]; [left | by right].
by elim: #|G| => //= _ ->.
Qed.

Lemma subnormalEr G H : H <|<| G ->
  H :=: G \/ (exists K : {group gT}, [/\ H <|<| K, K <| G & K \proper G]).
Proof.
case/subnormalP=> s Hs <-{G}.
elim/last_ind: s Hs => [|s G IHs]; first by left.
rewrite last_rcons -cats1 cat_path /= andbT; set K := last H s.
case/andP=> Hs nsKG; have:= normal_sub nsKG; rewrite subEproper.
case/predU1P=> [<- | prKG]; [exact: IHs | right; exists K; split=> //].
by apply/subnormalP; exists s.
Qed.

Lemma subnormalEl G H : H <|<| G ->
  H :=: G \/ (exists K : {group gT}, [/\ H <| K, K <|<| G & H \proper K]).
Proof.
case/subnormalP=> s Hs <-{G}; elim: s H Hs => /= [|K s IHs] H; first by left.
case/andP=> nsHK Ks; have:= normal_sub nsHK; rewrite subEproper.
case/predU1P=> [-> | prHK]; [exact: IHs | right; exists K; split=> //].
by apply/subnormalP; exists s.
Qed.

End Subnormal.

Arguments subnormalP {gT H G}.

Section MorphSubNormal.

Variable gT : finGroupType.
Implicit Type G H K : {group gT}.

Lemma morphim_subnormal (rT : finGroupType) G (f : {morphism G >-> rT}) H K :
  H <|<| K -> f @* H <|<| f @* K.
Proof.
case/subnormalP => s Hs <-{K}; apply/subnormalP.
elim: s H Hs => [|K s IHs] H /=; first by exists [::].
case/andP=> nsHK /IHs[fs Hfs <-].
by exists ([group of f @* K] :: fs); rewrite /= ?morphim_normal.
Qed.

Lemma quotient_subnormal H G K : G <|<| K -> G / H <|<| K / H.
Proof. exact: morphim_subnormal. Qed.

End MorphSubNormal.

Section MaxProps.

Variable gT : finGroupType.
Implicit Types G H M : {group gT}.

Lemma maximal_eqP M G :
  reflect (M \subset G  /\
             forall H, M \subset H -> H \subset G -> H :=: M \/ H :=: G)
       (maximal_eq M G).
Proof.
rewrite subEproper /maximal_eq; case: eqP => [->|_]; first left.
  by split=> // H sGH sHG; right; apply/eqP; rewrite eqEsubset sHG.
apply: (iffP maxgroupP) => [] [sMG maxM]; split=> // H.
  by move/maxM=> maxMH; rewrite subEproper; case/predU1P; auto.
by rewrite properEneq => /andP[/eqP neHG sHG] /maxM[].
Qed.

Lemma maximal_exists H G :
    H \subset G ->
  H :=: G \/ (exists2 M : {group gT}, maximal M G & H \subset M).
Proof.
rewrite subEproper; case/predU1P=> sHG; first by left.
suff [M *]: {M : {group gT} | maximal M G & H \subset M} by right; exists M.
exact: maxgroup_exists.
Qed.

Lemma mulg_normal_maximal G M H :
  M <| G -> maximal M G -> H \subset G -> ~~ (H \subset M) -> (M * H = G)%g.
Proof.
case/andP=> sMG nMG /maxgroupP[_ maxM] sHG not_sHM.
apply/eqP; rewrite eqEproper mul_subG // -norm_joinEr ?(subset_trans sHG) //.
by apply: contra not_sHM => /maxM <-; rewrite ?joing_subl ?joing_subr.
Qed.

End MaxProps.

Section MinProps.

Variable gT : finGroupType.
Implicit Types G H M : {group gT}.

Lemma minnormal_exists G H : H :!=: 1 -> G \subset 'N(H) ->
  {M : {group gT} | minnormal M G & M \subset H}.
Proof. by move=> ntH nHG; apply: mingroup_exists (H) _; rewrite ntH. Qed.

End MinProps.

Section MorphPreMax.

Variables (gT rT : finGroupType) (D : {group gT}) (f : {morphism D >-> rT}).
Variables (M G : {group rT}).
Hypotheses (dM : M \subset f @* D) (dG : G \subset f @* D).

Lemma morphpre_maximal : maximal (f @*^-1 M) (f @*^-1 G) = maximal M G.
Proof.
apply/maxgroupP/maxgroupP; rewrite morphpre_proper //= => [] [ltMG maxM].
  split=> // H ltHG sMH; have dH := subset_trans (proper_sub ltHG) dG.
  rewrite -(morphpreK dH) [f @*^-1 H]maxM ?morphpreK ?morphpreSK //.
  by rewrite morphpre_proper.
split=> // H ltHG sMH.
have dH: H \subset D := subset_trans (proper_sub ltHG) (subsetIl D _).
have defH: f @*^-1 (f @* H) = H.
  by apply: morphimGK dH; apply: subset_trans sMH; apply: ker_sub_pre.
rewrite -defH morphpre_proper ?morphimS // in ltHG.
by rewrite -defH [f @* H]maxM // -(morphpreK dM) morphimS.
Qed.

Lemma morphpre_maximal_eq : maximal_eq (f @*^-1 M) (f @*^-1 G) = maximal_eq M G.
Proof. by rewrite /maximal_eq morphpre_maximal !eqEsubset !morphpreSK. Qed.

End MorphPreMax.

Section InjmMax.

Variables (gT rT : finGroupType) (D : {group gT}) (f : {morphism D >-> rT}).
Variables M G L : {group gT}.

Hypothesis injf : 'injm f.
Hypotheses (dM : M \subset D) (dG : G \subset D) (dL : L \subset D).

Lemma injm_maximal : maximal (f @* M) (f @* G) = maximal M G.
Proof.
rewrite -(morphpre_invm injf) -(morphpre_invm injf G).
by rewrite morphpre_maximal ?morphim_invm.
Qed.

Lemma injm_maximal_eq : maximal_eq (f @* M) (f @* G) = maximal_eq M G.
Proof. by rewrite /maximal_eq injm_maximal // injm_eq. Qed.

Lemma injm_maxnormal : maxnormal (f @* M) (f @* G) (f @* L) = maxnormal M G L.
Proof.
pose injfm := (injm_proper injf, injm_norms, injmSK injf, subsetIl).
apply/maxgroupP/maxgroupP; rewrite !injfm // => [[nML maxM]].
  split=> // H nHL sMH; have [/proper_sub sHG _] := andP nHL.
  have dH := subset_trans sHG dG; apply: (injm_morphim_inj injf) => //.
  by apply: maxM; rewrite !injfm.
split=> // fH nHL sMH; have [/proper_sub sfHG _] := andP nHL.
have{sfHG} dfH: fH \subset f @* D := subset_trans sfHG (morphim_sub f G).
by rewrite -(morphpreK dfH) !injfm // in nHL sMH *; rewrite (maxM _ nHL).
Qed.

Lemma injm_minnormal : minnormal (f @* M) (f @* G) = minnormal M G.
Proof.
pose injfm := (morphim_injm_eq1 injf, injm_norms, injmSK injf, subsetIl).
apply/mingroupP/mingroupP; rewrite !injfm // => [[nML minM]].
  split=> // H nHG sHM; have dH := subset_trans sHM dM.
  by apply: (injm_morphim_inj injf) => //; apply: minM; rewrite !injfm.
split=> // fH nHG sHM; have dfH := subset_trans sHM (morphim_sub f M).
by rewrite -(morphpreK dfH) !injfm // in nHG sHM *; rewrite (minM _ nHG).
Qed.

End InjmMax.

Section QuoMax.

Variables (gT : finGroupType) (K G H : {group gT}).

Lemma cosetpre_maximal (Q R : {group coset_of K}) :
  maximal (coset K @*^-1 Q) (coset K @*^-1 R) = maximal Q R.
Proof. by rewrite morphpre_maximal ?sub_im_coset. Qed.

Lemma cosetpre_maximal_eq (Q R : {group coset_of K}) :
  maximal_eq (coset K @*^-1 Q) (coset K @*^-1 R) = maximal_eq Q R.
Proof. by rewrite /maximal_eq !eqEsubset !cosetpreSK cosetpre_maximal. Qed.

Lemma quotient_maximal :
  K <| G -> K <| H -> maximal (G / K) (H / K) = maximal G H.
Proof. by move=> nKG nKH; rewrite -cosetpre_maximal ?quotientGK. Qed.

Lemma quotient_maximal_eq :
  K <| G -> K <| H -> maximal_eq (G / K) (H / K) = maximal_eq G H.
Proof. by move=> nKG nKH; rewrite -cosetpre_maximal_eq ?quotientGK. Qed.

Lemma maximalJ x : maximal (G :^ x) (H :^ x) = maximal G H.
Proof.
rewrite -{1}(setTI G) -{1}(setTI H) -!morphim_conj.
by rewrite injm_maximal ?subsetT ?injm_conj.
Qed.

Lemma maximal_eqJ x : maximal_eq (G :^ x) (H :^ x) = maximal_eq G H.
Proof. by rewrite /maximal_eq !eqEsubset !conjSg maximalJ. Qed.

End QuoMax.

Section MaxNormalProps.

Variables (gT : finGroupType).
Implicit Types (A B C : {set gT}) (G H K L M : {group gT}).

Lemma maxnormal_normal A B : maxnormal A B B -> A <| B.
Proof.
by case/maxsetP=> /and3P[/gen_set_id /= -> pAB nAB]; rewrite /normal proper_sub.
Qed.

Lemma maxnormal_proper A B C : maxnormal A B C -> A \proper B.
Proof.
by case/maxsetP=> /and3P[gA pAB _] _; apply: (sub_proper_trans (subset_gen A)).
Qed.

Lemma maxnormal_sub A B C : maxnormal A B C -> A \subset B.
Proof.
by move=> maxA; rewrite proper_sub //; apply: (maxnormal_proper maxA).
Qed.

Lemma ex_maxnormal_ntrivg G : G :!=: 1-> {N : {group gT} | maxnormal N G G}.
Proof.
move=> ntG; apply: ex_maxgroup; exists [1 gT]%G; rewrite norm1 proper1G.
by rewrite subsetT ntG.
Qed.

Lemma maxnormalM G H K :
  maxnormal H G G -> maxnormal K G G -> H :<>: K -> H * K = G.
Proof.
move=> maxH maxK /eqP; apply: contraNeq => ltHK_G.
have [nsHG nsKG] := (maxnormal_normal maxH, maxnormal_normal maxK).
have cHK: commute H K.
  exact: normC (subset_trans (normal_sub nsHG) (normal_norm nsKG)).
wlog suffices: H K {maxH} maxK nsHG nsKG cHK ltHK_G / H \subset K.
  by move=> IH; rewrite eqEsubset !IH // -cHK.
have{maxK} /maxgroupP[_ maxK] := maxK.
apply/joing_idPr/maxK; rewrite ?joing_subr //= comm_joingE //.
by rewrite properEneq ltHK_G; apply: normalM.
Qed.

Lemma maxnormal_minnormal G L M :
    G \subset 'N(M) -> L \subset 'N(G) ->  maxnormal M G L ->
  minnormal (G / M) (L / M).
Proof.
move=> nMG nGL /maxgroupP[/andP[/andP[sMG ltMG] nML] maxM]; apply/mingroupP.
rewrite -subG1 quotient_sub1 ?ltMG ?quotient_norms //.
split=> // Hb /andP[ntHb nHbL]; have nsMG: M <| G by apply/andP.
case/inv_quotientS=> // H defHb sMH sHG; rewrite defHb; congr (_ / M).
apply/eqP; rewrite eqEproper sHG /=; apply: contra ntHb => ltHG.
have nsMH: M <| H := normalS sMH sHG nsMG.
rewrite defHb quotientS1 // (maxM H) // ltHG /=  -(quotientGK nsMH) -defHb.
exact: norm_quotient_pre.
Qed.

Lemma minnormal_maxnormal G L M :
  M <| G -> L \subset 'N(M) -> minnormal (G / M) (L / M) -> maxnormal M G L.
Proof.
case/andP=> sMG nMG nML /mingroupP[/andP[/= ntGM _] minGM]; apply/maxgroupP.
split=> [|H /andP[/andP[sHG ltHG] nHL] sMH].
  by rewrite /proper sMG nML andbT; apply: contra ntGM => /quotientS1 ->.
apply/eqP; rewrite eqEsubset sMH andbT -quotient_sub1 ?(subset_trans sHG) //.
rewrite subG1; apply: contraR ltHG => ntHM; rewrite -(quotientSGK nMG) //.
by rewrite (minGM (H / M)%G) ?quotientS // ntHM quotient_norms.
Qed.

End MaxNormalProps.

Section Simple.

Implicit Types gT rT : finGroupType.

Lemma simpleP gT (G : {group gT}) :
  reflect (G :!=: 1 /\ forall H : {group gT}, H <| G -> H :=: 1 \/ H :=: G)
          (simple G).
Proof.
apply: (iffP mingroupP); rewrite normG andbT => [[ntG simG]].
  split=> // N /andP[sNG nNG].
  by case: (eqsVneq N 1) => [|ntN]; [left | right; apply: simG; rewrite ?ntN].
split=> // N /andP[ntN nNG] sNG.
by case: (simG N) ntN => // [|->]; [apply/andP | case/eqP].
Qed.

Lemma quotient_simple gT (G H : {group gT}) :
  H <| G -> simple (G / H) = maxnormal H G G.
Proof.
move=> nsHG; have nGH := normal_norm nsHG.
by apply/idP/idP; [apply: minnormal_maxnormal | apply: maxnormal_minnormal].
Qed.

Lemma isog_simple gT rT (G : {group gT}) (M : {group rT}) :
  G \isog M -> simple G = simple M.
Proof.
move=> eqGM; wlog suffices: gT rT G M eqGM / simple M -> simple G.
  by move=> IH; apply/idP/idP; apply: IH; rewrite // isog_sym.
case/isogP: eqGM => f injf <- /simpleP[ntGf simGf].
apply/simpleP; split=> [|N nsNG]; first by rewrite -(morphim_injm_eq1 injf).
rewrite -(morphim_invm injf (normal_sub nsNG)).
have: f @* N <| f @* G by rewrite morphim_normal.
by case/simGf=> /= ->; [left | right]; rewrite (morphim1, morphim_invm).
Qed.

Lemma simple_maxnormal gT (G : {group gT}) : simple G = maxnormal 1 G G.
Proof.
by rewrite -quotient_simple ?normal1 // -(isog_simple (quotient1_isog G)).
Qed.

End Simple.

Section Chiefs.

Variable gT : finGroupType.
Implicit Types G H U V : {group gT}.

Lemma chief_factor_minnormal G V U :
  chief_factor G V U -> minnormal (U / V) (G / V).
Proof.
case/andP=> maxV /andP[sUG nUG]; apply: maxnormal_minnormal => //.
by have /andP[_ nVG] := maxgroupp maxV; apply: subset_trans sUG nVG.
Qed.

Lemma acts_irrQ G U V :
    G \subset 'N(V) -> V <| U ->
  acts_irreducibly G (U / V) 'Q = minnormal (U / V) (G / V).
Proof.
move=> nVG nsVU; apply/mingroupP/mingroupP; case=> /andP[->] /=.
  rewrite astabsQ // subsetI nVG /= => nUG minUV.
  rewrite quotient_norms //; split=> // H /andP[ntH nHG] sHU.
  by apply: minUV (sHU); rewrite ntH -(cosetpreK H) actsQ // norm_quotient_pre.
rewrite sub_quotient_pre // => nUG minU; rewrite astabsQ //.
rewrite (subset_trans nUG); last first.
  by rewrite subsetI subsetIl /= -{2}(quotientGK nsVU) morphpre_norm.
split=> // H /andP[ntH nHG] sHU.
rewrite -{1}(cosetpreK H) astabsQ ?normal_cosetpre ?subsetI ?nVG //= in nHG.
apply: minU sHU; rewrite ntH; apply: subset_trans (quotientS _ nHG) _.
by rewrite -{2}(cosetpreK H) quotient_norm.
Qed.

Lemma chief_series_exists H G :
  H <| G -> {s | (G.-chief).-series 1%G s & last 1%G s = H}.
Proof.
elim: {H}_.+1 {-2}H (ltnSn #|H|) => // m IHm U leUm nsUG.
have [-> | ntU] := eqVneq U 1%G; first by exists [::].
have [V maxV]: {V : {group gT} | maxnormal V U G}.
  by apply: ex_maxgroup; exists 1%G; rewrite proper1G ntU norms1.
have /andP[ltVU nVG] := maxgroupp maxV.
have [||s ch_s defV] := IHm V; first exact: leq_trans (proper_card ltVU) _.
  by rewrite /normal (subset_trans (proper_sub ltVU) (normal_sub nsUG)).
exists (rcons s U); last by rewrite last_rcons.
by rewrite rcons_path defV /= ch_s /chief_factor; apply/and3P.
Qed.

End Chiefs.

Section Central.

Variables (gT : finGroupType) (G : {group gT}).
Implicit Types H K : {group gT}.

Lemma central_factor_central H K :
  central_factor G H K -> (K / H) \subset 'Z(G / H).
Proof. by case/and3P=> /quotient_cents2r *; rewrite subsetI quotientS. Qed.

Lemma central_central_factor H K :
  (K / H) \subset 'Z(G / H) -> H <| K -> H <| G -> central_factor G H K.
Proof.
case/subsetIP=> sKGb cGKb /andP[sHK nHK] /andP[sHG nHG].
by rewrite /central_factor -quotient_cents2 // cGKb sHK -(quotientSGK nHK).
Qed.

End Central.


Load GradVer2LemmaIndependent.
Import Semantics.

Definition phiSatisfiable (p : phi) := exists H r A, evalphi H r A p.

(*GRADUAL*)
Definition gphi := prod bool phi.
Definition pphi := phi -> Prop.

Definition gphiSatisfiable (gp : gphi) := phiSatisfiable (snd gp).

Definition gUnknown : gphi := (true, []).
Definition gThat (p : phi) : gphi := (false, p).
Definition gThatOrSub (p : phi) : gphi := (true, p).

Definition pFromList (ps : list phi) := fun p => In p ps.

Definition pincl (pp1 pp2 : pphi) :=
  forall p, pp1 p -> pp2 p.

Definition evalgphi H r A (gp : gphi) := evalphi H r A (snd gp).
Definition evalpphi H r A (pp : pphi) := exists p, pp p /\ evalphi H r A p.

Definition sfrmgphi (a : A_s) (p : gphi) : Prop :=
  fst p = true \/ sfrmphi a (snd p).

Definition good (p : phi) := phiSatisfiable p /\ sfrmphi [] p.
Definition gGood (gp : gphi) := gphiSatisfiable gp /\ sfrmgphi [] gp.
Definition ppGood (pp : pphi) :=
  (exists p, pp p) /\
  (forall p, pp p -> good p).

(* concretization *)
Definition gGamma' (phi : gphi) : pphi :=
  match fst phi with
  | false => (fun p => p = snd phi)
  | true => (fun p => good p /\ phiImplies p (snd phi))
  end.

Inductive gGamma : gphi -> pphi -> Prop :=
| GammaAll : forall gp pp,
  gGood gp ->
  gGamma' gp = pp ->
  gGamma gp pp
.

Definition gphiImplies (gp1 : gphi) (p2 : phi) : Prop :=
  exists p1, gGamma' gp1 p1 /\ phiImplies p1 p2.

(* abstraction *)
Definition ppIsSingleton (p : phi) (pp : pphi) :=
  pp p /\ (forall p', pp p' -> p' = p).
Definition ppHasUpperBound (p : phi) (pp : pphi) :=
  forall p', pp p' -> phiImplies p' p.
Definition ppHasSupremum (p : phi) (pp : pphi) :=
  ppHasUpperBound p pp /\ (forall p', ppHasUpperBound p' pp -> phiImplies p p').
Definition ppHasMaximum (p : phi) (pp : pphi) :=
  pp p /\ (forall p', pp p' -> phiImplies p' p).

Inductive gAlpha : pphi -> gphi -> Prop :=
| AlphaAll : forall gp pp,
  ppGood pp ->
  gGood gp ->
  pincl pp (gGamma' gp) ->
  (forall gp', gGood gp' -> pincl pp (gGamma' gp') -> pincl (gGamma' gp) (gGamma' gp')) ->
  gAlpha pp gp
.

Definition PLIFT1 (prop : phi -> Prop) : (pphi -> Prop) :=
  fun pp => exists p', pp p' /\ prop p'.

Definition GLIFT1 (prop : phi -> Prop) : (gphi -> Prop) :=
  fun gp => exists pp, gGamma gp pp /\ PLIFT1 prop pp.

Definition PLIFT2 (prop : phi -> phi -> Prop) : (pphi -> pphi -> Prop) :=
  fun pp1 pp2 => exists p1' p2', pp1 p1' /\ pp2 p2' /\ prop p1' p2'.

Definition GLIFT2 (prop : phi -> phi -> Prop) : (gphi -> gphi -> Prop) :=
  fun gp1 gp2 => exists pp1 pp2, gGamma gp1 pp1 /\ gGamma gp2 pp2 /\ PLIFT2 prop pp1 pp2.

Definition PLIFT4 (prop : phi -> phi -> phi -> phi -> Prop) : (pphi -> pphi -> pphi -> pphi -> Prop) :=
  fun pp1 pp2 pp3 pp4 => exists p1' p2' p3' p4', pp1 p1' /\ pp2 p2' /\ pp3 p3' /\ pp4 p4' /\ prop p1' p2' p3' p4'.

Definition GLIFT4 (prop : phi -> phi -> phi -> phi -> Prop) : (gphi -> gphi -> gphi -> gphi -> Prop) :=
  fun gp1 gp2 gp3 gp4 => exists pp1 pp2 pp3 pp4, gGamma gp1 pp1 /\ gGamma gp2 pp2 /\ gGamma gp3 pp3 /\ gGamma gp4 pp4 /\ PLIFT4 prop pp1 pp2 pp3 pp4.

(* hasWellFormedSubtype *)
Axiom hasWellFormedSubtype : forall p,
  phiSatisfiable p ->
  ∃ p' : phi, phiSatisfiable p' ∧ sfrmphi [] p' ∧ FV p = FV p' ∧ phiImplies p' p.

Definition pphiEquals (pp1 pp2 : pphi) :=
    pincl pp1 pp2 /\ pincl pp2 pp1.

Definition gphiEquals (gp1 gp2 : gphi) :=
  exists pp1 pp2,
    gGamma gp1 pp1 /\ gGamma gp2 pp2 /\
    pphiEquals pp1 pp2.


From Coq Require Import Ensembles.
From Coq Require Import List.
From Coq Require Import Arith Lia.
From hydras.Ackermann Require Import folProp.
From hydras.Ackermann Require Import folProof.
From hydras.Ackermann Require Import folReplace.
From hydras.Ackermann Require Import folLogic3.
From hydras.Ackermann Require Import subProp.
From hydras.Ackermann Require Import ListExt.
From Goedel Require Import fixPoint.
From Goedel Require Import codeSysPrf.
From hydras.Ackermann Require Import NNtheory.
From hydras.Ackermann Require Import code.
From Goedel Require Import PRrepresentable.
From hydras.Ackermann Require Import expressible.
From hydras.Ackermann Require Import checkPrf.
From hydras.Ackermann Require Import codeNatToTerm.
From hydras Require Import Compat815.

Section Rosser's_Incompleteness.

Definition codeFormula := codeFormula LNN codeLNTFunction codeLNNRelation.

Variable T : System.

Hypothesis extendsNN : Included _ NN T.

Variable repT : Formula.
Variable v0 : nat.
Hypothesis
  freeVarRepT : forall v : nat, In v (freeVarFormula LNN repT) -> v = v0.
Hypothesis
  expressT1 :
    forall f : Formula,
    mem _ T f ->
    SysPrf T (substituteFormula LNN repT v0 (natToTerm (codeFormula f))).
Hypothesis
  expressT2 :
    forall f : Formula,
    ~ mem _ T f ->
    SysPrf T
      (notH (substituteFormula LNN repT v0 (natToTerm (codeFormula f)))).

Definition codeSysPrf :=
  codeSysPrf LNN codeLNTFunction codeLNNRelation codeArityLNTF codeArityLNNR
    codeArityLNTFIsPR codeArityLNNRIsPR repT v0.

Definition codeSysPrfCorrect1 :=
  codeSysPrfCorrect1 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNTFIsCorrect1 codeArityLNNRIsPR
    codeArityLNNRIsCorrect1 T extendsNN T repT v0 freeVarRepT expressT1.

Definition codeSysPrfCorrect2 :=
  codeSysPrfCorrect2 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNTFIsCorrect1 codeArityLNNRIsPR
    codeArityLNNRIsCorrect1 T extendsNN T repT v0 freeVarRepT expressT2.

Definition codeSysPrfCorrect3 :=
  codeSysPrfCorrect3 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNTFIsCorrect1
    codeArityLNTFIsCorrect2 codeArityLNNRIsPR codeArityLNNRIsCorrect1
    codeArityLNNRIsCorrect2 codeLNTFunctionInj codeLNNRelationInj T extendsNN.

Definition codePrf := codePrf LNN codeLNTFunction codeLNNRelation.

Definition codeSysPrfNot :=
  codeSysPrfNot LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNNRIsPR repT v0.

Definition freeVarCodeSysPrfN :=
  freeVarCodeSysPrfN LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNNRIsPR repT v0 freeVarRepT.

Definition codeSysPrfNCorrect1 :=
  codeSysPrfNCorrect1 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNTFIsCorrect1 codeArityLNNRIsPR
    codeArityLNNRIsCorrect1 T extendsNN T repT v0 freeVarRepT expressT1.

Definition codeSysPrfNCorrect2 :=
  codeSysPrfNCorrect2 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNTFIsCorrect1 codeArityLNNRIsPR
    codeArityLNNRIsCorrect1 T extendsNN T repT v0 freeVarRepT expressT2.

Definition codeSysPrfNCorrect3 :=
  codeSysPrfNCorrect3 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNTFIsCorrect1
    codeArityLNTFIsCorrect2 codeArityLNNRIsPR codeArityLNNRIsCorrect1
    codeArityLNNRIsCorrect2 codeLNTFunctionInj codeLNNRelationInj T extendsNN
    repT v0 freeVarRepT.

Lemma decideAxioms :
  (forall x : Formula, mem _ T x \/ ~ mem _ T x) ->
  forall x : Formulas,
    (forall g : Formula, In g x -> mem _ T g) \/
      (exists g : Formula, In g x /\ ~ mem _ T g).
Proof.
  intros H x; induction x as [| a x Hrecx].
  - left.
    intros g H0; elim H0.
  - destruct Hrecx as [H0| H0].
    + induction (H a) as [H1 | H1].
      * left; intros g [H2 | H2].
        -- now subst.
        -- auto.
      * right; exists a; split.
        -- auto with datatypes.
        -- assumption.
    + right. destruct H0 as [x0 [H0 H1]].
      exists x0;  split.
      * auto with datatypes.
      * assumption.
Qed.

Lemma searchProof :
  (forall x : Formula, mem _ T x \/ ~ mem _ T x) ->
  forall (a b : Formula) (A : Formulas) (p : Prf LNN A a),
    (exists B : Formulas,
        (exists q : Prf LNN B b,
            codePrf _ _ q < S (codePrf _ _ p) /\
              (forall x : Formula, In x B -> mem _ T x))) \/
      (forall (B : Formulas) (q : Prf LNN B b),
          codePrf _ _ q < S (codePrf _ _ p) ->
          exists g : Formula, In g B /\ ~ mem _ T g).
Proof.
  intros H a b A p.
  induction (S (codePrf A a p)).
  - right; intros B q H0; lia.
  - induction IHn as [H0| H0].
    + left; decompose record H0 /r; intros x x0 H1 H3;
        exists x, x0; auto.
    + induction
        (eq_nat_dec
           (checkPrf LNN codeLNTFunction codeLNNRelation codeArityLNTF codeArityLNNR
              (codeFormula b) n) 0) as [a0 | b0].
      * right; intros B q H1;
          induction (proj1 (Nat.lt_eq_cases _ _) (proj1 (Nat.lt_succ_r _ _) H1)).
        -- eauto.
        -- rewrite <- H2 in a0.
           rewrite
             (checkPrfCorrect1 LNN codeLNTFunction codeLNNRelation codeArityLNTF
                codeArityLNNR codeArityLNTFIsCorrect1 codeArityLNNRIsCorrect1)
             in a0.
           discriminate a0.
      * decompose record
          (checkPrfCorrect2 LNN codeLNTFunction codeLNNRelation codeArityLNTF
             codeArityLNNR codeArityLNTFIsCorrect1 codeArityLNTFIsCorrect2
             codeArityLNNRIsCorrect1 codeArityLNNRIsCorrect2 codeLNTFunctionInj
             codeLNNRelationInj _ _ b0) /r; intros x H2 x0 x1 H3.

        assert (H1:  x = b).
        { eapply codeFormulaInj.
          - apply codeLNTFunctionInj.
          - apply codeLNNRelationInj.
          - assumption.
        }
        rewrite <- H1.
        induction (decideAxioms H x0) as [H4 | ?].
        -- left; exists x0, x1.
           unfold codePrf; rewrite H3;  auto.
        -- right; intros B q H5.
           induction (proj1 (Nat.lt_eq_cases _ _) (proj1 (Nat.lt_succ_r _ _) H5))
             as [H6 | H6].
           ++ rewrite <- H1 in H0; eauto.
           ++ assert (H7: B = x0).
              { eapply (codePrfInjAxm LNN) with (p := q) (q := x1).
                - apply codeLNTFunctionInj.
                - apply codeLNNRelationInj.
                - transitivity n.
                  + unfold codePrf in H6; apply H6.
                  + symmetry; apply H3.
              }
              now rewrite H7.
Qed.

(** To prove the strong contructive result we need the decidability of T **)

Theorem Rosser'sIncompleteness :
 (forall x : Formula, mem _ T x \/ ~ mem _ T x) ->
 exists f : Formula,
   (forall v : nat, ~ In v (freeVarFormula LNN f)) /\
   (SysPrf T f \/ SysPrf T (notH f) -> Inconsistent LNN T).
Proof.
  intros decide.
  set
    (A :=
       forallH 1
         (impH codeSysPrf
            (existH 2
               (andH (LT (var 2) (var 1))
                  (substituteFormula LNN codeSysPrfNot 1 (var 2)))))).
  destruct (FixPointLNN A 0) as [x [H0 H1]].
  exists x; split.
  -  intros v H; induction (H1 v) as [H2 H3].
     assert (H4: In v (List.remove eq_nat_dec 0 (freeVarFormula LNN A)))
     by apply H2, H.
     unfold A in H4; SimplFreeVar.
     + assert (H4: v <= 1).
       { apply
           (freeVarCodeSysPrf LNN codeLNTFunction codeLNNRelation codeArityLNTF
              codeArityLNNR codeArityLNTFIsPR codeArityLNNRIsPR repT v0 freeVarRepT).
         apply H5.
       }
       lia.
     + assert (H4: v <= 1) by (apply freeVarCodeSysPrfN; assumption); lia.
  - intros [H| H].
    + unfold Inconsistent in |- *.
      intro f; elim H; intros x0 [x1 H2].
      induction (searchProof decide _ (notH x) _ x1) as [H3 | H3].
      * decompose record H3 /r; intros x2 x3 H4 H6.
        apply contradiction with x.
        -- assumption.
        -- now exists x2, x3.
      * apply
          contradiction
          with
          (existH 2
             (andH (LT (var 2) (natToTerm (codePrf _ _ x1)))
                (substituteFormula LNN
                   (substituteFormula LNN codeSysPrfNot 0
                      (natToTerm (codeFormula x))) 1 (var 2)))).
        -- apply impE with
             (existH 2
                (andH (LT (var 2) (natToTerm (codePrf x0 x x1)))
                   (substituteFormula LNN
                      (substituteFormula LNN
                         (substituteFormula LNN codeSysPrfNot 0
                            (natToTerm (codeFormula x))) 1 (var 2)) 1
                      (natToTerm (codePrf _ _ x1))))).
           ++ apply iffE1; apply sysExtend with NN.
              ** apply extendsNN.
              ** apply (reduceExist LNN).
                 --- apply closedNN.
                 --- apply (reduceAnd LNN).
                     +++ apply iffRefl.
                     +++ apply (subFormulaNil LNN).
                         intro H4; induction (freeVarSubFormula3 _ _ _ _ _ H4).
                         *** now apply (in_remove_neq _ _ _ _ _ H5).
                         *** simpl in H5; decompose sum H5; discriminate H6.
           ++ replace (LT (var 2) (natToTerm (codePrf _ _ x1)))
                with
                (substituteFormula LNN (LT (var 2) (var 1)) 1
                   (natToTerm (codePrf _ _ x1))).
              ** rewrite <- (subFormulaAnd LNN).
                 apply impE with
                   (existH 2
                      (substituteFormula LNN
                         (andH  (LT (var 2) (var 1))
                            (substituteFormula LNN
                               (substituteFormula LNN codeSysPrfNot 1 (var 2)) 0
                               (natToTerm (codeFormula x)))) 1
                         (natToTerm (codePrf x0 x x1)))).
                 --- apply iffE1; apply sysExtend with NN.
                     +++ apply extendsNN.
                     +++ apply (reduceExist LNN).
                         *** apply closedNN.
                         *** apply (reduceSub LNN).
                             apply closedNN.
                             apply (reduceAnd LNN).
                             apply iffRefl.
                             apply (subFormulaExch LNN).
                             discriminate.
                             intros H4; simpl in H4.
                             decompose sum H4.
                             discriminate H5.
                             apply closedNatToTerm.
                 --- replace (LT (var 2) (var 1))
                       with
                       (substituteFormula LNN (LT (var 2) (var 1)) 0
                          (natToTerm (codeFormula x))).
                     rewrite <- (subFormulaAnd LNN).
                     +++ replace
                         (existH 2
                            (substituteFormula LNN
                               (substituteFormula LNN
                                  (andH  (LT (var 2) (var 1))
                                     (substituteFormula LNN codeSysPrfNot 1 (var 2))) 0
                                  (natToTerm (codeFormula x))) 1
                               (natToTerm (codePrf x0 x x1))))
                         with
                         (substituteFormula LNN
                            (existH 2
                               (substituteFormula LNN
                                  (andH (LT (var 2) (var 1))
                                     (substituteFormula LNN codeSysPrfNot 1 (var 2))) 0
                                  (natToTerm (codeFormula x)))) 1
                            (natToTerm (codePrf x0 x x1))).
                         *** replace
                             (existH 2
                                (substituteFormula LNN
                                   (andH (LT (var 2) (var 1))
                                      (substituteFormula LNN codeSysPrfNot 1 (var 2))) 0
                                   (natToTerm (codeFormula x)))) with
                             (substituteFormula LNN
                                (existH 2
                                   (andH (LT (var 2) (var 1))
                                      (substituteFormula LNN codeSysPrfNot 1 (var 2)))) 0
                                (natToTerm (codeFormula x))).
                             apply impE with
                               (substituteFormula LNN
                                  (substituteFormula LNN codeSysPrf 0
                                     (natToTerm (codeFormula x))) 1
                                  (natToTerm (codePrf _ _ x1))).
                             repeat rewrite <- (subFormulaImp LNN).
                             apply forallE.
                             replace
                               (forallH 1
                                  (substituteFormula LNN
                                     (impH codeSysPrf
                                        (existH 2
                                           (andH (LT (var 2) (var 1))
                                              (substituteFormula LNN codeSysPrfNot 1
                                                 (var 2))))) 0
                                     (natToTerm (codeFormula x))))
                               with
                               (substituteFormula LNN
                                  (forallH 1
                                     (impH codeSysPrf
                                        (existH 2
                                           (andH (LT (var 2) (var 1))
                                              (substituteFormula LNN codeSysPrfNot 1
                                                 (var 2)))))) 0
                                  (natToTerm (codeFormula x))).
                             apply impE with x.
                             apply iffE1.
                             apply sysExtend with NN.
                             apply extendsNN.
                             apply H0.
                             assumption.
                             rewrite (subFormulaForall LNN).
                             induction (eq_nat_dec 1 0) as [a | b].
                             ---- discriminate a.
                             ---- induction
                                 (In_dec eq_nat_dec 1 (freeVarTerm LNN
                                                         (natToTerm (codeFormula x))))
                                   as [a | b0].
                                  ++++ elim (closedNatToTerm _ _ a).
                                  ++++ reflexivity.
                             ---- now apply codeSysPrfCorrect1.
                             ---- rewrite (subFormulaExist LNN).
                                  induction (eq_nat_dec 2 0) as [a | b].
                                  discriminate a.
                                  induction (In_dec eq_nat_dec 2
                                               (freeVarTerm LNN
                                                  (natToTerm (codeFormula x)))).
                                  elim (closedNatToTerm _ _ a).
                                  reflexivity.
                         *** rewrite (subFormulaExist LNN).
                             induction (eq_nat_dec 2 1) as [a | b].
                             discriminate a.
                             induction
                               (In_dec eq_nat_dec 2 (freeVarTerm LNN
                                                       (natToTerm (codePrf x0 x x1))))
                               as [a | b0].
                             elim (closedNatToTerm _ _ a).
                             reflexivity.
                     +++ unfold LT; rewrite (subFormulaRelation LNN); now simpl.
              ** unfold LT; rewrite (subFormulaRelation LNN); now simpl.
        -- apply nExist.
           set
             (E :=
                nat_rec (fun _ => Formula) (equal Zero Zero)
                  (fun (n : nat) (rec : Formula) =>
                     andH
                       (notH
                          (substituteFormula LNN
                             (substituteFormula LNN codeSysPrfNot 0
                                (natToTerm (codeFormula x))) 1 (natToTerm n))) rec)
                  (codePrf x0 x x1)).
           assert (H4: forall x : nat, ~ In x (freeVarFormula LNN E)).
           { unfold E; clear H3 E; induction (codePrf x0 x x1) as [ | n IHn].
            - simpl; auto.
            - intros x2; unfold nat_rec, nat_rect; intro H3.
              set
                (Q :=
                   (fix F (n : nat) : (fun _ : nat => Formula) n :=
                      match n with
                      | O => equal Zero Zero
                      | S n0 =>
                          (fun (n1 : nat) (rec : Formula) =>
                             andH
                               (notH
                                  (substituteFormula LNN
                                     (substituteFormula LNN codeSysPrfNot 0
                                        (natToTerm (codeFormula x))) 1
                                     (natToTerm n1))) rec) n0 (F n0)
                      end) n).
              SimplFreeVar.
              + apply (Nat.le_ngt x2 1).
                apply freeVarCodeSysPrfN.
                * assumption.
                * lia.
              +  apply (IHn x2 H3).
           }
           apply impE with E.
           ++ apply sysExtend with NN.
              apply extendsNN.
              apply impI.
              apply forallI.
              **  intros [x2 [H5 H6]].
                  induction H6 as [x2 H6| x2 H6].
                  --- apply (closedNN 2); exists x2; auto.
                  --- induction H6; now apply (H4 2).
              ** apply nAnd; unfold orH;
                   apply impTrans with (LT (var 2) (natToTerm (codePrf x0 x x1))).
                 --- apply impI, nnE.
                     apply Axm; right; constructor.
                 --- apply impI; apply impE with E.
                     +++ apply impE with (LT (var 2) (natToTerm (codePrf x0 x x1))).
                         do 2 apply sysWeaken.
                         *** apply boundedLT.
                             intros n H5; rewrite (subFormulaImp LNN).
                             rewrite (subFormulaNot LNN).
                             apply impE with
                               (impH E
                                  (notH
                                     (substituteFormula LNN
                                        (substituteFormula LNN codeSysPrfNot 0
                                           (natToTerm (codeFormula x))) 1
                                        (natToTerm n)))).
                             apply iffE2.
                             apply (reduceImp LNN).
                             apply (subFormulaNil LNN).
                             apply H4.
                             apply (reduceNot LNN).
                             apply (subFormulaTrans LNN).
                             intros H6; SimplFreeVar.
                             apply (Nat.le_ngt 2 1).
                             apply freeVarCodeSysPrfN.
                             assumption.
                             apply Nat.lt_succ_diag_r.
                             unfold E in |- *.
                             clear E H4 H3.
                             apply impI.
                             induction (codePrf x0 x x1).
                             elim (Nat.nlt_0_r _ H5).
                             unfold nat_rec, nat_rect;
                               set
                                 (Q :=
                                    (fix F (n1 : nat) : (fun _ : nat => Formula) n1 :=
                                       match n1 with
                                       | O => equal Zero Zero
                                       | S n2 =>
                                           (fun (n3 : nat) (rec : Formula) =>
                                              andH
                                                (notH
                                                   (substituteFormula LNN
                                                      (substituteFormula LNN
                                                         codeSysPrfNot 0
                                                         (natToTerm (codeFormula x))) 1
                                                      (natToTerm n3))) rec) n2 (F n2)
                                       end) n0).
                             induction (Compat815.le_lt_or_eq _ _
                                          (Compat815.lt_n_Sm_le _ _ H5)).
                             apply impE with Q.
                             apply sysWeaken.
                             apply impI.
                             apply (IHn0 H3).
                             eapply andE2.
                             apply Axm; right; constructor.
                             rewrite H3.
                             eapply andE1.
                             apply Axm; right; constructor.
                         *** apply Axm; right; constructor.
                     +++ apply Axm; left; right; constructor.
           ++ unfold E in |- *; clear H4 E.
              induction (codePrf x0 x x1) as [ | n IHn].
              ** simpl; apply eqRefl.
              ** simpl; apply andI.
                 induction
                   (eq_nat_dec
                      (checkPrf LNN codeLNTFunction codeLNNRelation
                         codeArityLNTF codeArityLNNR
                         (codeFormula (notH x)) n) 0) as [a | b].
                 --- unfold codeSysPrfNot.
                     apply codeSysPrfNCorrect3.
                     intros A0 p H4; rewrite H4 in a.
                     rewrite
                       (checkPrfCorrect1 LNN codeLNTFunction codeLNNRelation
                          codeArityLNTF
                          codeArityLNNR codeArityLNTFIsCorrect1
                          codeArityLNNRIsCorrect1)
                       in a; discriminate a.
                 --- decompose record
                       (checkPrfCorrect2 LNN codeLNTFunction codeLNNRelation
                          codeArityLNTF
                          codeArityLNNR codeArityLNTFIsCorrect1
                          codeArityLNTFIsCorrect2
                          codeArityLNNRIsCorrect1
                          codeArityLNNRIsCorrect2 codeLNTFunctionInj
                          codeLNNRelationInj _ _ b) /r;
                       intros x2 H5 x3 x4 H6.

                     rewrite <- H6.
                     assert (H4: x2 = notH x).
                     { eapply codeFormulaInj.
                       - apply codeLNTFunctionInj.
                       - apply codeLNNRelationInj.
                       - assumption.
                     }
                     cut (code.codePrf LNN codeLNTFunction codeLNNRelation x3 x2 x4 = n).
                     +++ generalize x4; clear H6 x4; rewrite H4.
                         intros x4 H6; apply codeSysPrfNCorrect2.
                         eapply H3.
                         apply Nat.lt_lt_succ_r.
                         rewrite <- H6.
                         apply Nat.lt_succ_diag_r.
                     +++ assumption.
                 --- apply IHn; intros B q H4.
                     eapply H3.
                     apply Nat.lt_lt_succ_r.
                     apply H4.
    + unfold Inconsistent; intros f.
      elim H; intros x0 [x1 H2].
      induction (searchProof decide _ x _ x1) as [H3 | H3].
      * decompose record H3 /r; intros x2 x3 H4 H6.
        apply contradiction with x.
        -- exists x2, x3; assumption.
        -- assumption.
      * apply
          contradiction
          with
          (substituteFormula LNN A 0
             (natToTermLNN (code.codeFormula LNN codeLNTFunction codeLNNRelation x))).
        -- unfold A; rewrite (subFormulaForall LNN).
           induction (eq_nat_dec 1 0) as [a | b].
           ++ discriminate a.
           ++ induction
               (In_dec eq_nat_dec 1
                  (freeVarTerm LNN
                     (natToTermLNN (code.codeFormula LNN codeLNTFunction
                                      codeLNNRelation x)))) as [a | b0].
              ** elim (closedNatToTerm _ _ a).
              ** clear b0 b.
                 set
                   (E :=
                      nat_rec (fun _ => Formula) (equal Zero Zero)
                        (fun (n : nat) (rec : Formula) =>
                           andH
                             (notH
                                (substituteFormula LNN
                                   (substituteFormula LNN codeSysPrf 0
                                      (natToTerm (codeFormula x)))
                                   1 (natToTerm n))) rec) (S (codePrf _ _ x1))).
                 assert (H4: forall x : nat, ~ In x (freeVarFormula LNN E)).
                 { unfold E; clear H3 E.
                   induction (S (codePrf x0 (notH x) x1)).
                   - simpl; auto.
                   - intros x2; unfold nat_rec, nat_rect; intros H3.
                     SimplFreeVar.
                     + apply (Compat815.le_not_lt x2 1).
                       * apply
                           (freeVarCodeSysPrf LNN codeLNTFunction
                              codeLNNRelation codeArityLNTF
                              codeArityLNNR codeArityLNTFIsPR
                              codeArityLNNRIsPR repT v0 freeVarRepT).
                         apply H4.
                       * destruct x2 as [| n0].
                         -- elim H6; reflexivity.
                         -- destruct n0.
                            ++ elim H5; reflexivity.
                            ++ apply Compat815.lt_n_S.
                               apply Nat.lt_0_succ.
                     + apply (IHn _ H3).
                 }
                 apply impE with E.
                 --- set
                     (G :=
                        substituteFormula LNN
                          (substituteFormula LNN codeSysPrfNot 0
                             (natToTerm (codeFormula x))) 1
                          (natToTerm (codePrf x0 (notH x) x1))).
                     apply impE with G.
                     +++ apply sysExtend with NN.
                         *** assumption.
                         *** repeat apply impI; apply forallI.
                             unfold not in |- *; intros [x2 [H5 H6]].
                             induction H6 as [x2 H6| x2 H6].
                             induction H6 as [x2 H6| x2 H6].
                             apply (closedNN 1).
                             exists x2.
                             auto.
                             induction H6.
                             unfold G in H5.
                             SimplFreeVar.
                             induction H6.
                             apply (H4 _ H5).
                             rewrite (subFormulaImp LNN).
                             rewrite (subFormulaExist LNN).
                             induction (eq_nat_dec 2 0) as [a | b].
                             discriminate a.
                             induction
                               (In_dec eq_nat_dec 2
                                  (freeVarTerm LNN
                                     (natToTermLNN
                                        (code.codeFormula LNN
                                           codeLNTFunction codeLNNRelation x)))).
                             elim (closedNatToTerm _ _ a).
                             clear b0 b.
                             rewrite (subFormulaAnd LNN).
                             replace
                               (substituteFormula LNN (LT (var 2) (var 1)) 0
                                  (natToTermLNN
                                     (code.codeFormula LNN
                                        codeLNTFunction codeLNNRelation x)))
                               with
                               (LT (var 2) (var 1)).
                             apply orE with
                               (orH (LT (var 1) (natToTerm (codePrf x0 (notH x) x1)))
                                  (equal (var 1) (natToTerm (codePrf x0 (notH x) x1))))
                               (LT (natToTerm (codePrf x0 (notH x) x1)) (var 1)).
                             repeat simple apply sysWeaken.
                             apply impE with
                               (orH (LT (var 1) (natToTerm (codePrf x0 (notH x) x1)))
                                  (orH (equal (var 1)
                                          (natToTerm (codePrf x0 (notH x) x1)))
                                     (LT (natToTerm (codePrf x0 (notH x) x1))
                                        (var 1)))).
                             apply impI.
                             apply orSys.
                             apply orI1.
                             apply orI1.
                             apply Axm; right; constructor.
                             apply orSys.
                             apply orI1.
                             apply orI2.
                             apply Axm; right; constructor.
                             apply orI2.
                             apply Axm; right; constructor.
                             apply nn9.
                             apply impI.
                             apply impE with G.
                             apply impE with E.
                             apply impE with (LT (var 1)
                                                (natToTerm
                                                   (S (codePrf x0 (notH x) x1)))).
                             repeat simple apply sysWeaken.
                             apply boundedLT.
                             intros n H5; repeat apply impE.
                             repeat rewrite (subFormulaImp LNN).
                             repeat apply impI.
                             fold codeFormula.
                             apply
                               contradiction
                               with
                               (substituteFormula LNN
                                  (substituteFormula LNN codeSysPrf 0
                                     (natToTermLNN (codeFormula x))) 1
                                  (natToTerm n)).
                             apply Axm; right; constructor.
                             apply sysWeaken.
                             apply impE with E.
                             repeat simple apply sysWeaken.
                             apply impI.
                             clear H3 H4.
                             induction (S (codePrf x0 (notH x) x1)).
                             elim (Nat.nlt_0_r _ H5).
                             induction (Compat815.le_lt_or_eq _ _
                                          (Compat815.lt_n_Sm_le _ _ H5)).
                             unfold E;
                               apply impE with
                               (nat_rec (fun _ : nat => Formula) (equal Zero Zero)
                                  (fun (n : nat) (rec : Formula) =>
                                     andH
                                       (notH
                                          (substituteFormula LNN
                                             (substituteFormula LNN codeSysPrf 0
                                                (natToTerm (codeFormula x))) 1
                                             (natToTerm n))) rec) n0).
                             apply sysWeaken.
                             repeat apply impI.
                             apply IHn0.
                             assumption.
                             simpl; eapply andE2.
                             apply Axm; right; constructor.
                             unfold E; simpl; rewrite H3.
                             eapply andE1.
                             apply Axm; right; constructor.
                             apply impE with (substituteFormula LNN E 1 (natToTerm n)).
                             apply iffE1.
                             apply (subFormulaNil LNN).
                             apply H4.
                             apply Axm; left; right; constructor.
                             apply impE with
                               (orH (LT (var 1) (natToTerm (codePrf x0 (notH x) x1)))
                                  (equal (var 1) (natToTerm (codePrf x0 (notH x) x1)))).
                             repeat simple apply sysWeaken.
                             simpl; apply nnPlusNotNeeded.
                             apply Axm; right; constructor.
                             apply Axm; left; right; constructor.
                             apply Axm; do 2 left; right; constructor.
                             repeat apply impI.
                             apply sysWeaken.
                             apply existI with (natToTerm (codePrf x0 (notH x) x1)).
                             rewrite (subFormulaAnd LNN).
                             apply andI.
                             unfold LT in |- *.
                             rewrite (subFormulaRelation LNN).
                             simpl in |- *.
                             apply Axm; right; constructor.
                             apply sysWeaken.
                             apply sysWeaken.
                             apply impE with
                               (substituteFormula LNN
                                  (substituteFormula LNN codeSysPrfNot 0
                                     (natToTerm (codeFormula x))) 1
                                  (natToTerm (codePrf x0 (notH x) x1))).
                             apply sysWeaken.
                             apply iffE2.
                             fold codeFormula;
                               apply iffTrans with
                               (substituteFormula LNN
                                  (substituteFormula LNN
                                     (substituteFormula LNN codeSysPrfNot 0
                                        (natToTermLNN (codeFormula x))) 1 (var 2)) 2
                                  (natToTerm (codePrf x0 (notH x) x1))).
                             repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
                             apply (subFormulaExch LNN).
                             discriminate.
                             unfold not in |- *; intros; SimplFreeVar.
                             discriminate H6.
                             apply closedNatToTerm.
                             apply (subFormulaTrans LNN).
                             intros H5; SimplFreeVar.
                             apply (Compat815.le_not_lt 2 1).
                             apply freeVarCodeSysPrfN.
                             assumption.
                             apply Nat.lt_succ_diag_r.
                             apply Axm; right; constructor.
                             unfold LT; rewrite (subFormulaRelation LNN).
                             reflexivity.
                     +++ unfold G; now apply codeSysPrfNCorrect1.
                 --- clear H4; unfold E; clear E.
                     induction (S (codePrf x0 (notH x) x1)) as [| n IHn].
                     +++ simpl; apply eqRefl.
                     +++ simpl; apply andI.
                         induction
                           (eq_nat_dec
                              (checkPrf LNN codeLNTFunction
                                 codeLNNRelation codeArityLNTF codeArityLNNR
                                 (codeFormula x) n) 0) as [a | b].
                         *** unfold codeSysPrf, codeFormula; apply codeSysPrfCorrect3.
                             intros A0 p H4; rewrite H4 in a.
                             rewrite
                               (checkPrfCorrect1 LNN codeLNTFunction
                                  codeLNNRelation codeArityLNTF
                                  codeArityLNNR codeArityLNTFIsCorrect1
                                  codeArityLNNRIsCorrect1)
                               in a.
                             discriminate a.
                         *** decompose record
                               (checkPrfCorrect2 LNN codeLNTFunction
                                  codeLNNRelation codeArityLNTF
                                  codeArityLNNR codeArityLNTFIsCorrect1
                                  codeArityLNTFIsCorrect2
                                  codeArityLNNRIsCorrect1 codeArityLNNRIsCorrect2
                                  codeLNTFunctionInj
                                  codeLNNRelationInj _ _ b) /r;
                               intros x2 H5 x3 x4 H6.

                             rewrite <- H6.
                             assert (H4: x2 = x).
                             { eapply (codeFormulaInj LNN).
                               apply codeLNTFunctionInj.
                               apply codeLNNRelationInj.
                               assumption.
                             }
                             rewrite <- H4.
                             apply codeSysPrfCorrect2.
                             rewrite <- H4 in H3.
                             apply H3 with x4.
                             rewrite <- H6.
                             apply Nat.lt_succ_diag_r.
                         *** apply IHn.
                             intros B q H4; eapply H3.
                             apply Nat.lt_lt_succ_r.
                             apply H4.
        -- apply impE with (notH x).
           +++ apply cp2.
               apply iffE2.
               apply sysExtend with NN.
               *** apply extendsNN.
               *** assumption.
           +++ assumption.
Qed.

End Rosser's_Incompleteness.

Definition RepresentsInSelf (T:System) :=
  exists rep:Formula, exists v:nat,
    (forall x : nat, In x (freeVarFormula LNN rep) -> x = v)  /\
      (forall f : Formula,
          mem Formula T f ->
          SysPrf T (substituteFormula LNN rep v (natToTerm (codeFormula f)))) /\
      (forall f : Formula,
          ~ mem Formula T f ->
          SysPrf T
            (notH (substituteFormula LNN rep v (natToTerm (codeFormula f))))).

Definition DecidableSet (A:_)(s:Ensemble A) :=
  (forall x : A,
      mem A s x \/
        ~ mem A s x).

Theorem Incompleteness :
  forall T : System,
    Included Formula NN T ->
    RepresentsInSelf T ->
    DecidableSet Formula T ->
    exists f : Formula,
      (Sentence f) /\
        (SysPrf T f \/ SysPrf T (notH f) -> Inconsistent LNN T).
Proof.
  intros T H H0 H1; repeat induction H0.
  apply Rosser'sIncompleteness with x x0; auto; tauto.
Qed.


From LogRel.AutoSubst Require Import core unscoped Ast Extra.
From LogRel Require Import Utils BasicAst Notations Context NormalForms Weakening GenericTyping LogicalRelation DeclarativeInstance Validity.
From LogRel.LogicalRelation Require Import Induction Irrelevance Escape Reflexivity Weakening Neutral Transitivity Reduction Application.
From LogRel.Substitution Require Import Irrelevance Properties Conversion SingleSubst Reflexivity.

Set Universe Polymorphism.

Section Application.
Context `{GenericTypingProperties}.

Set Printing Primitive Projection Parameters.

Set Printing Universes.

Lemma appValid {Γ F G t u l}
  {VΓ : [||-v Γ]}
  {VF : [Γ ||-v<l> F | VΓ]}
  {VΠFG : [Γ ||-v<l> tProd F G | VΓ]}
  (Vt : [Γ ||-v<l> t : tProd F G | VΓ | VΠFG])
  (Vu : [Γ ||-v<l> u : F | VΓ | VF])
  (VGu := substSΠ VΠFG Vu) :
  [Γ ||-v<l> tApp t u : G[u..] | VΓ | VGu].
Proof.
  opector; intros.
  - instValid Vσ.
    epose (appTerm RVΠFG RVt RVu (substSΠaux VΠFG Vu _ _ wfΔ Vσ)).
    irrelevance.
  - instAllValid Vσ Vσ' Vσσ'.
    unshelve epose (appcongTerm _ REVt RVu _ REVu (substSΠaux VΠFG Vu _ _ wfΔ Vσ)).
    2: irrelevance.
    eapply LRTmRedConv; tea.
    unshelve eapply LRTyEqSym. 2,3: tea.
Qed.

Lemma appcongValid {Γ F G t u a b l}
  {VΓ : [||-v Γ]}
  {VF : [Γ ||-v<l> F | VΓ]}
  {VΠFG : [Γ ||-v<l> tProd F G | VΓ]}
  (Vtu : [Γ ||-v<l> t ≅ u : tProd F G | VΓ | VΠFG])
  (Va : [Γ ||-v<l> a : F | VΓ | VF])
  (Vb : [Γ ||-v<l> b : F | VΓ | VF])
  (Vab : [Γ ||-v<l> a ≅ b : F | VΓ | VF])
  (VGa := substSΠ VΠFG Va) :
  [Γ ||-v<l> tApp t a ≅ tApp u b : G[a..] | VΓ | VGa].
Proof.
  constructor; intros; instValid Vσ.
  unshelve epose proof (appcongTerm _ RVtu _ _ _ (substSΠaux VΠFG Va _ _ wfΔ Vσ)); fold subst_term; cycle 5.
  all: try irrelevance.
  now eapply LRCumulative.
Qed.

End Application.


From iris.base_logic Require Export invariants.
From iris.program_logic Require Export weakestpre.
From iris.heap_lang Require Export lang proofmode notation.
From iris.heap_lang.lib Require Export nondet_bool.
From iris_examples.proph Require Import eager_coin_spec.
From iris_examples.proph.lib Require Import one_shot_proph.
From iris.prelude Require Import options.

(* Lazy implementation of the eager specification. The value of the coin is
unknown at the time of the creation of the coin. As a consequence, we rely on
a *one-shot* prophecy variable. *)

Definition new_lazy_coin : val :=
  λ: <>, (ref NONE, NewProph).

Definition read_lazy_coin : val :=
  λ: "cp",
  let: "c" := Fst "cp" in
  let: "p" := Snd "cp" in
  match: !"c" with
    NONE => let: "r" := nondet_bool #() in
           "c" <- SOME "r";; resolve_proph: "p" to: "r";; "r"
  | SOME "b" => "b"
  end.

Section proof.
  Context `{!heapGS Σ}.

  Definition val_to_bool (v : val) : bool := bool_decide (v = #true).

  Lemma val_to_bool_of_bool (b : bool) :
    val_to_bool #b = b.
  Proof.
    by destruct b.
  Qed.

  Definition lazy_coin (cp : val) (b : bool) : iProp Σ :=
    (∃ (c : loc) (p : proph_id) (v : val),
        ⌜cp = (#c, #p)%V⌝ ∗
        (c ↦ SOMEV #b ∨ (c ↦ NONEV ∗ proph1 p v ∗ ⌜b = val_to_bool v⌝)))%I.

  Lemma lazy_coin_exclusive (cp : val) (b1 b2 : bool) :
    lazy_coin cp b1 -∗ lazy_coin cp b2 -∗ False.
  Proof.
    iIntros "H1 H2".
    iDestruct "H1" as (c1 p1 v1) "[-> H1]".
    iDestruct "H2" as (c2 p2 v2) "[% H2]".
    simplify_eq.
    iDestruct "H1" as "[Hc1 | [Hc1 _]]";
    iDestruct "H2" as "[Hc2 | [Hc2 _]]";
    by iDestruct (mapsto_valid_2 with "Hc1 Hc2") as %[??].
  Qed.

  Lemma new_lazy_coin_spec :
    {{{ True }}}
      new_lazy_coin #()
    {{{ c b, RET c; lazy_coin c b }}}.
  Proof.
    iIntros (Φ) "_ HΦ". wp_lam.
    wp_apply wp_new_proph1; first done. iIntros (p v) "Hp".
    wp_alloc c as "Hc". wp_pair. iModIntro.
    iApply ("HΦ" $! (#c, #p)%V).
    iExists c, p, v. iSplit; first done. iRight. by iFrame.
  Qed.

  Lemma read_lazy_coin_spec cp b :
    {{{ lazy_coin cp b }}}
      read_lazy_coin cp
    {{{ RET #b; lazy_coin cp b }}}.
  Proof.
    iIntros (Φ) "Hc HΦ".
    iDestruct "Hc" as (c p v ->) "[Hc | [Hc [Hp ->]]]".
    - wp_lam. wp_load. wp_match. iApply "HΦ". iModIntro.
      iExists c, p, #(). iSplit; first done. by iLeft.
    - wp_lam. wp_load. wp_match.
      wp_apply nondet_bool_spec; first done. iIntros (r) "_".
      wp_let. wp_store.
      wp_apply (wp_resolve1 with "Hp"); first done.
      wp_pures. iIntros "!> ->". wp_pures.
      rewrite !val_to_bool_of_bool. iApply "HΦ". iModIntro.
      iExists c, p, #(). iSplit; first done. by iLeft.
  Qed.

End proof.

Definition lazy_coin_spec_instance `{!heapGS Σ} :
  eager_coin_spec.eager_coin_spec Σ :=
  {| eager_coin_spec.new_coin_spec := new_lazy_coin_spec;
     eager_coin_spec.read_coin_spec := read_lazy_coin_spec;
     eager_coin_spec.coin_exclusive := lazy_coin_exclusive |}.

Typeclasses Opaque lazy_coin.