(*  Title:       Application of the Saturation Framework to Bachmair and Ganzinger's RP
    Author:      Sophie Tourret <stourret at mpi-inf.mpg.de>, 2018-2020
    Author:      Jasmin Blanchette <j.c.blanchette at vu.nl>, 2020
*)

section \<open>Application of the Saturation Framework to Bachmair and Ganzinger's \textsf{RP}\<close>

theory FO_Ordered_Resolution_Prover_Revisited
  imports
    Ordered_Resolution_Prover.FO_Ordered_Resolution_Prover
    Saturation_Framework.Given_Clause_Architectures
    Clausal_Calculus
    Soundness
begin

text \<open>The main results about Bachmair and Ganzinger's \textsf{RP} prover, as established in
Section 4.3 of their \emph{Handbook} chapter and formalized by Schlichtkrull et al., are re-proved
here using the saturation framework of Waldmann et al.\<close>

subsection \<open>Setup\<close>

no_notation true_lit (infix "\<Turnstile>l" 50)
no_notation true_cls (infix "\<Turnstile>" 50)
no_notation true_clss (infix "\<Turnstile>s" 50)
no_notation true_cls_mset (infix "\<Turnstile>m" 50)

hide_type (open) Inference_System.inference

hide_const (open) Inference_System.Infer Inference_System.main_prem_of
  Inference_System.side_prems_of Inference_System.prems_of Inference_System.concl_of
  Inference_System.concls_of Inference_System.infer_from

type_synonym 'a old_inference = "'a Inference_System.inference"

abbreviation "old_Infer \<equiv> Inference_System.Infer"
abbreviation "old_side_prems_of \<equiv> Inference_System.side_prems_of"
abbreviation "old_main_prem_of \<equiv> Inference_System.main_prem_of"
abbreviation "old_concl_of \<equiv> Inference_System.concl_of"
abbreviation "old_prems_of \<equiv> Inference_System.prems_of"
abbreviation "old_concls_of \<equiv> Inference_System.concls_of"
abbreviation "old_infer_from \<equiv> Inference_System.infer_from"

lemmas old_infer_from_def = Inference_System.infer_from_def

subsection \<open>Library\<close>

lemma set_zip_replicate_right[simp]:
  "set (zip xs (replicate (length xs) y)) = (\<lambda>x. (x, y)) ` set xs"
  by (induct xs) auto

subsection \<open>Ground Layer\<close>

context FO_resolution_prover
begin

no_notation RP (infix "\<leadsto>" 50)
notation RP (infix "\<leadsto>RP" 50)

interpretation gr: ground_resolution_with_selection "S_M S M"
  using selection_axioms by unfold_locales (fact S_M_selects_subseteq S_M_selects_neg_lits)+

definition G_Inf :: "'a clause set \<Rightarrow> 'a clause inference set" where
  "G_Inf M = {Infer (CAs @ [DA]) E |CAs DA AAs As E. gr.ord_resolve M CAs DA AAs As E}"

lemma G_Inf_have_prems: "\<iota> \<in> G_Inf M \<Longrightarrow> prems_of \<iota> \<noteq> []"
  unfolding G_Inf_def by auto

lemma G_Inf_reductive: "\<iota> \<in> G_Inf M \<Longrightarrow> concl_of \<iota> < main_prem_of \<iota>"
  unfolding G_Inf_def by (auto dest: gr.ord_resolve_reductive)

interpretation G: sound_inference_system "G_Inf M" "{{#}}" "(\<TTurnstile>e)"
proof
  fix \<iota>
  assume i_in: "\<iota> \<in> G_Inf M"
  moreover
  {
    fix I
    assume I_ent_prems: "I \<TTurnstile>s set (prems_of \<iota>)"
    obtain CAs AAs As where
      the_inf: "gr.ord_resolve M CAs (main_prem_of \<iota>) AAs As (concl_of \<iota>)" and
      CAs: "CAs = side_prems_of \<iota>"
      using i_in unfolding G_Inf_def by auto
    then have "I \<TTurnstile> concl_of \<iota>"
      using gr.ord_resolve_sound[of M CAs "main_prem_of \<iota>" AAs As "concl_of \<iota>" I]
      by (metis I_ent_prems G_Inf_have_prems i_in insert_is_Un set_mset_mset set_prems_of
          true_clss_insert true_clss_set_mset)
  }
  ultimately show "set (inference.prems_of \<iota>) \<TTurnstile>e {concl_of \<iota>}"
    by simp
qed

interpretation G: clausal_counterex_reducing_inference_system "G_Inf M" "gr.INTERP M"
proof
  fix N D
  assume
    "{#} \<notin> N" and
    "D \<in> N" and
    "\<not> gr.INTERP M N \<TTurnstile> D" and
    "\<And>C. C \<in> N \<Longrightarrow> \<not> gr.INTERP M N \<TTurnstile> C \<Longrightarrow> D \<le> C"
  then obtain CAs AAs As E where
    cas_in: "set CAs \<subseteq> N" and
    n_mod_cas: "gr.INTERP M N \<TTurnstile>m mset CAs" and
    ca_prod: "\<And>CA. CA \<in> set CAs \<Longrightarrow> gr.production M N CA \<noteq> {}" and
    e_res: "gr.ord_resolve M CAs D AAs As E" and
    n_nmod_e: "\<not> gr.INTERP M N \<TTurnstile> E" and
    e_lt_d: "E < D"
    using gr.ord_resolve_counterex_reducing by blast
  define \<iota> where
    "\<iota> = Infer (CAs @ [D]) E"

  have "\<iota> \<in> G_Inf M"
    unfolding \<iota>_def G_Inf_def using e_res by auto
  moreover have "prems_of \<iota> \<noteq> []"
    unfolding \<iota>_def by simp
  moreover have "main_prem_of \<iota> = D"
    unfolding \<iota>_def by simp
  moreover have "set (side_prems_of \<iota>) \<subseteq> N"
    unfolding \<iota>_def using cas_in by simp
  moreover have "gr.INTERP M N \<TTurnstile>s set (side_prems_of \<iota>)"
    unfolding \<iota>_def using n_mod_cas ca_prod by (simp add: gr.productive_imp_INTERP true_clss_def)
  moreover have "\<not> gr.INTERP M N \<TTurnstile> concl_of \<iota>"
    unfolding \<iota>_def using n_nmod_e by simp
  moreover have "concl_of \<iota> < D"
    unfolding \<iota>_def using e_lt_d by simp
  ultimately show "\<exists>\<iota> \<in> G_Inf M. prems_of \<iota> \<noteq> [] \<and> main_prem_of \<iota> = D \<and> set (side_prems_of \<iota>) \<subseteq> N \<and>
    gr.INTERP M N \<TTurnstile>s set (side_prems_of \<iota>) \<and> \<not> gr.INTERP M N \<TTurnstile> concl_of \<iota> \<and> concl_of \<iota> < D"
    by blast
qed

interpretation G: clausal_counterex_reducing_calculus_with_standard_redundancy "G_Inf M"
  "gr.INTERP M"
  using G_Inf_have_prems G_Inf_reductive
  by (unfold_locales) simp_all

interpretation G: statically_complete_calculus "{{#}}" "G_Inf M" "(\<TTurnstile>e)" "G.Red_I M" G.Red_F
  by unfold_locales (use G.clausal_saturated_complete in blast)

subsection \<open>First-Order Layer\<close>

abbreviation \<G>_F :: \<open>'a clause \<Rightarrow> 'a clause set\<close> where
  \<open>\<G>_F \<equiv> grounding_of_cls\<close>

abbreviation \<G>_Fset :: \<open>'a clause set \<Rightarrow> 'a clause set\<close> where
  \<open>\<G>_Fset \<equiv> grounding_of_clss\<close>

lemmas \<G>_F_def = grounding_of_cls_def
lemmas \<G>_Fset_def = grounding_of_clss_def

definition \<G>_I :: \<open>'a clause set \<Rightarrow> 'a clause inference \<Rightarrow> 'a clause inference set\<close> where
  \<open>\<G>_I M \<iota> = {Infer (prems_of \<iota> \<cdot>\<cdot>cl \<rho>s) (concl_of \<iota> \<cdot> \<rho>) |\<rho> \<rho>s.
     is_ground_subst_list \<rho>s \<and> is_ground_subst \<rho>
     \<and> Infer (prems_of \<iota> \<cdot>\<cdot>cl \<rho>s) (concl_of \<iota> \<cdot> \<rho>) \<in> G_Inf M}\<close>

abbreviation
  \<G>_I_opt :: \<open>'a clause set \<Rightarrow> 'a clause inference \<Rightarrow> 'a clause inference set option\<close>
where
  \<open>\<G>_I_opt M \<iota> \<equiv> Some (\<G>_I M \<iota>)\<close>

definition F_Inf :: "'a clause inference set" where
  "F_Inf = {Infer (CAs @ [DA]) E | CAs DA AAs As \<sigma> E. ord_resolve_rename S CAs DA AAs As \<sigma> E}"

lemma F_Inf_have_prems: "\<iota> \<in> F_Inf \<Longrightarrow> prems_of \<iota> \<noteq> []"
  unfolding F_Inf_def by force

interpretation F: lifting_intersection F_Inf "{{#}}" UNIV G_Inf "\<lambda>N. (\<TTurnstile>e)" G.Red_I "\<lambda>N. G.Red_F"
  "{{#}}" "\<lambda>N. \<G>_F" \<G>_I_opt "\<lambda>D C C'. False"
proof (unfold_locales; (intro ballI)?)
  show "UNIV \<noteq> {}"
    by (rule UNIV_not_empty)
next
  show "consequence_relation {{#}} (\<TTurnstile>e)"
    by (fact consequence_relation_axioms)
next
  show "\<And>M. tiebreaker_lifting {{#}} F_Inf {{#}} (\<TTurnstile>e) (G_Inf M) (G.Red_I M) G.Red_F \<G>_F (\<G>_I_opt M)
    (\<lambda>D C C'. False)"
  proof
    fix M \<iota>
    show "the (\<G>_I_opt M \<iota>) \<subseteq> G.Red_I M (\<G>_F (concl_of \<iota>))"
      unfolding option.sel
    proof
      fix \<iota>'
      assume "\<iota>' \<in> \<G>_I M \<iota>"
      then obtain \<rho> \<rho>s where
        \<iota>': "\<iota>' = Infer (prems_of \<iota> \<cdot>\<cdot>cl \<rho>s) (concl_of \<iota> \<cdot> \<rho>)" and
        \<rho>_gr: "is_ground_subst \<rho>" and
        \<rho>_infer: "Infer (prems_of \<iota> \<cdot>\<cdot>cl \<rho>s) (concl_of \<iota> \<cdot> \<rho>) \<in> G_Inf M"
        unfolding \<G>_I_def by blast

      show "\<iota>' \<in> G.Red_I M (\<G>_F (concl_of \<iota>))"
        unfolding G.Red_I_def G.redundant_infer_def mem_Collect_eq using \<iota>' \<rho>_gr \<rho>_infer
        by (metis inference.sel(2) G_Inf_reductive empty_iff ground_subst_ground_cls
            grounding_of_cls_ground insert_iff subst_cls_eq_grounding_of_cls_subset_eq
            true_clss_union)
    qed
  qed (auto simp: \<G>_F_def ex_ground_subst)
qed

notation F.entails_\<G> (infix "\<TTurnstile>\<G>e" 50)

lemma F_entails_\<G>_iff: "N1 \<TTurnstile>\<G>e N2 \<longleftrightarrow> \<Union> (\<G>_F ` N1) \<TTurnstile>e \<Union> (\<G>_F ` N2)"
  unfolding F.entails_\<G>_def by simp

lemma true_Union_grounding_of_cls_iff:
  "I \<TTurnstile>s (\<Union>C \<in> N. {C \<cdot> \<sigma> |\<sigma>. is_ground_subst \<sigma>}) \<longleftrightarrow> (\<forall>\<sigma>. is_ground_subst \<sigma> \<longrightarrow> I \<TTurnstile>s N \<cdot>cs \<sigma>)"
  unfolding true_clss_def subst_clss_def by blast

interpretation F: sound_inference_system F_Inf "{{#}}" "(\<TTurnstile>\<G>e)"
proof
  fix \<iota>
  assume i_in: "\<iota> \<in> F_Inf"
  moreover
  {
    fix I \<eta>
    assume
      I_entails_prems: "\<forall>\<sigma>. is_ground_subst \<sigma> \<longrightarrow> I \<TTurnstile>s set (prems_of \<iota>) \<cdot>cs \<sigma>" and
      \<eta>_gr: "is_ground_subst \<eta>"
    obtain CAs AAs As \<sigma> where
      the_inf: "ord_resolve_rename S CAs (main_prem_of \<iota>) AAs As \<sigma> (concl_of \<iota>)" and
      CAs: "CAs = side_prems_of \<iota>"
      using i_in unfolding F_Inf_def by auto
    have prems: "mset (prems_of \<iota>) = mset (side_prems_of \<iota>) + {#main_prem_of \<iota>#}"
      by (metis (no_types) F_Inf_have_prems[OF i_in] add.right_neutral append_Cons append_Nil2
          append_butlast_last_id mset.simps(2) mset_rev mset_single_iff_right rev_append
          rev_is_Nil_conv union_mset_add_mset_right)
    have "I \<TTurnstile> concl_of \<iota> \<cdot> \<eta>"
      using ord_resolve_rename_sound[OF the_inf, of I \<eta>, OF _ \<eta>_gr]
      unfolding CAs prems[symmetric] using I_entails_prems
      by (metis set_mset_mset set_mset_subst_cls_mset_subst_clss true_clss_set_mset)
  }
  ultimately show "set (inference.prems_of \<iota>) \<TTurnstile>\<G>e {concl_of \<iota>}"
    unfolding F.entails_\<G>_def \<G>_F_def true_Union_grounding_of_cls_iff by auto
qed

lemma G_Inf_overapprox_F_Inf: "\<iota>\<^sub>0 \<in> G.Inf_from M (\<Union> (\<G>_F ` M)) \<Longrightarrow> \<exists>\<iota> \<in> F.Inf_from M. \<iota>\<^sub>0 \<in> \<G>_I M \<iota>"
proof -
  assume \<iota>\<^sub>0_in: "\<iota>\<^sub>0 \<in> G.Inf_from M (\<Union> (\<G>_F ` M))"
  have prems_\<iota>\<^sub>0_in: "set (prems_of \<iota>\<^sub>0) \<subseteq> \<Union> (\<G>_F ` M)"
    using \<iota>\<^sub>0_in unfolding G.Inf_from_def by simp
  note \<iota>\<^sub>0_G_Inf = G.Inf_if_Inf_from[OF \<iota>\<^sub>0_in]
  then obtain CAs DA AAs As E where
    gr_res: \<open>gr.ord_resolve M CAs DA AAs As E\<close> and
    \<iota>\<^sub>0_is: \<open>\<iota>\<^sub>0 = Infer (CAs @ [DA]) E\<close>
    unfolding G_Inf_def by auto

  have CAs_in: \<open>set CAs \<subseteq> set (prems_of \<iota>\<^sub>0)\<close>
    by (simp add: \<iota>\<^sub>0_is subsetI)
  then have ground_CAs: \<open>is_ground_cls_list CAs\<close>
    using prems_\<iota>\<^sub>0_in union_grounding_of_cls_ground is_ground_cls_list_def is_ground_clss_def by auto
  have DA_in: \<open>DA \<in> set (prems_of \<iota>\<^sub>0)\<close>
    using \<iota>\<^sub>0_is by simp
  then have ground_DA: \<open>is_ground_cls DA\<close>
    using prems_\<iota>\<^sub>0_in union_grounding_of_cls_ground is_ground_clss_def by auto
  obtain \<sigma> where
    grounded_res: \<open>ord_resolve (S_M S M) CAs DA AAs As \<sigma> E\<close>
    using ground_ord_resolve_imp_ord_resolve[OF ground_DA ground_CAs
        gr.ground_resolution_with_selection_axioms gr_res] by auto
  have prems_ground: \<open>{DA} \<union> set CAs \<subseteq> \<G>_Fset M\<close>
    using prems_\<iota>\<^sub>0_in CAs_in DA_in unfolding \<G>_Fset_def by fast

  obtain \<eta>s \<eta> \<eta>2 CAs0 DA0 AAs0 As0 E0 \<tau> where
    ground_n: "is_ground_subst \<eta>" and
    ground_ns: "is_ground_subst_list \<eta>s" and
    ground_n2: "is_ground_subst \<eta>2" and
    ngr_res: "ord_resolve_rename S CAs0 DA0 AAs0 As0 \<tau> E0" and
    CAs0_is: "CAs0 \<cdot>\<cdot>cl \<eta>s = CAs" and
    DA0_is: "DA0 \<cdot> \<eta> = DA" and
    E0_is: "E0 \<cdot> \<eta>2 = E"  and
    prems_in: "{DA0} \<union> set CAs0 \<subseteq> M" and
    len_CAs0: "length CAs0 = length CAs" and
    len_ns: "length \<eta>s = length CAs"
    using ord_resolve_rename_lifting[OF _ grounded_res selection_axioms prems_ground] sel_stable
    by smt

  have "length CAs0 = length \<eta>s"
    using len_CAs0 len_ns by simp
  then have \<iota>\<^sub>0_is': "\<iota>\<^sub>0 = Infer ((CAs0 @ [DA0]) \<cdot>\<cdot>cl (\<eta>s @ [\<eta>])) (E0 \<cdot> \<eta>2)"
    unfolding \<iota>\<^sub>0_is by (auto simp: CAs0_is[symmetric] DA0_is[symmetric] E0_is[symmetric])

  define \<iota> :: "'a clause inference" where
    "\<iota> = Infer (CAs0 @ [DA0]) E0"

  have i_F_Inf: \<open>\<iota> \<in> F_Inf\<close>
    unfolding \<iota>_def F_Inf_def using ngr_res by auto
  have "\<exists>\<rho> \<rho>s. \<iota>\<^sub>0 = Infer ((CAs0 @ [DA0]) \<cdot>\<cdot>cl \<rho>s) (E0 \<cdot> \<rho>) \<and> is_ground_subst_list \<rho>s
    \<and> is_ground_subst \<rho> \<and> Infer ((CAs0 @ [DA0]) \<cdot>\<cdot>cl \<rho>s) (E0 \<cdot> \<rho>) \<in> G_Inf M"
    by (rule exI[of _ \<eta>2], rule exI[of _ "\<eta>s @ [\<eta>]"], use ground_ns in
        \<open>auto intro: ground_n ground_n2 \<iota>\<^sub>0_G_Inf[unfolded \<iota>\<^sub>0_is']
           simp: \<iota>\<^sub>0_is' is_ground_subst_list_def\<close>)
  then have \<open>\<iota>\<^sub>0 \<in> \<G>_I M \<iota>\<close>
    unfolding \<G>_I_def \<iota>_def CAs0_is[symmetric] DA0_is[symmetric] E0_is[symmetric] by simp
  moreover have \<open>\<iota> \<in> F.Inf_from M\<close>
    using prems_in i_F_Inf unfolding F.Inf_from_def \<iota>_def by simp
  ultimately show ?thesis
    by blast
qed

interpretation F: statically_complete_calculus "{{#}}" F_Inf "(\<TTurnstile>\<G>e)" F.Red_I_\<G> F.Red_F_\<G>_empty
proof (rule F.stat_ref_comp_to_non_ground_fam_inter; clarsimp; (intro exI)?)
  show "\<And>M. statically_complete_calculus {{#}} (G_Inf M) (\<TTurnstile>e) (G.Red_I M) G.Red_F"
    by (fact G.statically_complete_calculus_axioms)
next
  fix N
  assume "F.saturated N"
  show "F.ground.Inf_from_q N (\<Union> (\<G>_F ` N)) \<subseteq> {\<iota>. \<exists>\<iota>' \<in> F.Inf_from N. \<iota> \<in> \<G>_I N \<iota>'}
    \<union> G.Red_I N (\<Union> (\<G>_F ` N))"
    using G_Inf_overapprox_F_Inf unfolding F.ground.Inf_from_q_def \<G>_I_def by fastforce
qed

subsection \<open>Labeled First-Order or Given Clause Layer\<close>

datatype label = New | Processed | Old

abbreviation F_Equiv :: "'a clause \<Rightarrow> 'a clause \<Rightarrow> bool" (infix "\<doteq>" 50) where
  "C \<doteq> D \<equiv> generalizes C D \<and> generalizes D C"

abbreviation F_Prec :: "'a clause \<Rightarrow> 'a clause \<Rightarrow> bool" (infix "\<prec>\<cdot>" 50) where
  "C \<prec>\<cdot> D \<equiv> strictly_generalizes C D"

fun L_Prec :: "label \<Rightarrow> label \<Rightarrow> bool" (infix "\<sqsubset>l" 50) where
  "Old \<sqsubset>l l \<longleftrightarrow> l \<noteq> Old"
| "Processed \<sqsubset>l l \<longleftrightarrow> l = New"
| "New \<sqsubset>l l \<longleftrightarrow> False"

lemma irrefl_L_Prec: "\<not> l \<sqsubset>l l"
  by (cases l) auto

lemma trans_L_Prec: "l1 \<sqsubset>l l2 \<Longrightarrow> l2 \<sqsubset>l l3 \<Longrightarrow> l1 \<sqsubset>l l3"
  by (cases l1; cases l2; cases l3) auto

lemma wf_L_Prec: "wfP (\<sqsubset>l)"
  by (metis L_Prec.elims(2) L_Prec.simps(3) not_accp_down wfP_accp_iff)

interpretation FL: given_clause "{{#}}" F_Inf "{{#}}" UNIV "\<lambda>N. (\<TTurnstile>e)" G_Inf G.Red_I
  "\<lambda>N. G.Red_F" "\<lambda>N. \<G>_F" \<G>_I_opt "(\<doteq>)" "(\<prec>\<cdot>)" "(\<sqsubset>l)" Old
proof (unfold_locales; (intro ballI)?)
  show "equivp (\<doteq>)"
    unfolding equivp_def by (meson generalizes_refl generalizes_trans)
next
  show "po_on (\<prec>\<cdot>) UNIV"
    unfolding po_on_def irreflp_on_def transp_on_def
    using strictly_generalizes_irrefl strictly_generalizes_trans by auto
next
  show "wfp_on (\<prec>\<cdot>) UNIV"
    unfolding wfp_on_UNIV by (metis wf_strictly_generalizes)
next
  show "po_on (\<sqsubset>l) UNIV"
    unfolding po_on_def irreflp_on_def transp_on_def using irrefl_L_Prec trans_L_Prec by blast
next
  show "wfp_on (\<sqsubset>l) UNIV"
    unfolding wfp_on_UNIV by (rule wf_L_Prec)
next
  fix C1 D1 C2 D2
  assume
    "C1 \<doteq> D1"
    "C2 \<doteq> D2"
    "C1 \<prec>\<cdot> C2"
  then show "D1 \<prec>\<cdot> D2"
    by (smt antisym size_mset_mono size_subst strictly_generalizes_def generalizes_def
        generalizes_trans)
next
  fix N C1 C2
  assume "C1 \<doteq> C2"
  then show "\<G>_F C1 \<subseteq> \<G>_F C2"
    unfolding generalizes_def \<G>_F_def by clarsimp (metis is_ground_comp_subst subst_cls_comp_subst)
next
  fix N C2 C1
  assume "C2 \<prec>\<cdot> C1"
  then show "\<G>_F C1 \<subseteq> \<G>_F C2"
    unfolding strictly_generalizes_def generalizes_def \<G>_F_def
    by clarsimp (metis is_ground_comp_subst subst_cls_comp_subst)
next
  show "\<exists>l. L_Prec Old l"
    using L_Prec.simps(1) by blast
qed (auto simp: F_Inf_have_prems)

notation FL.Prec_FL (infix "\<sqsubset>" 50)
notation FL.entails_\<G>_L (infix "\<TTurnstile>\<G>Le" 50)
notation FL.derive (infix "\<rhd>L" 50)
notation FL.step (infix "\<leadsto>GC" 50)

lemma FL_Red_F_eq:
  "FL.Red_F N =
   {C. \<forall>D \<in> \<G>_F (fst C). D \<in> G.Red_F (\<Union> (\<G>_F ` fst ` N)) \<or> (\<exists>E \<in> N. E \<sqsubset> C \<and> D \<in> \<G>_F (fst E))}"
  unfolding FL.Red_F_def FL.Red_F_\<G>_q_def by auto

lemma mem_FL_Red_F_because_G_Red_F:
  "(\<forall>D \<in> \<G>_F (fst Cl). D \<in> G.Red_F (\<Union> (\<G>_F ` fst ` N))) \<Longrightarrow> Cl \<in> FL.Red_F N"
  unfolding FL_Red_F_eq by auto

lemma mem_FL_Red_F_because_Prec_FL:
  "(\<forall>D \<in> \<G>_F (fst Cl). \<exists>El \<in> N. El \<sqsubset> Cl \<and> D \<in> \<G>_F (fst El)) \<Longrightarrow> Cl \<in> FL.Red_F N"
  unfolding FL_Red_F_eq by auto

subsection \<open>Resolution Prover Layer\<close>

interpretation sq: selection "S_Q Sts"
  unfolding S_Q_def using S_M_selects_subseteq S_M_selects_neg_lits selection_axioms
  by unfold_locales auto

interpretation gd: ground_resolution_with_selection "S_Q Sts"
  by unfold_locales

interpretation src: standard_redundancy_criterion_counterex_reducing "gd.ord_\<Gamma> Sts"
  "ground_resolution_with_selection.INTERP (S_Q Sts)"
  by unfold_locales

definition lclss_of_state :: "'a state \<Rightarrow> ('a clause \<times> label) set" where
  "lclss_of_state St =
   (\<lambda>C. (C, New)) ` N_of_state St \<union> (\<lambda>C. (C, Processed)) ` P_of_state St
   \<union> (\<lambda>C. (C, Old)) ` Q_of_state St"

lemma image_hd_lclss_of_state[simp]: "fst ` lclss_of_state St = clss_of_state St"
  unfolding lclss_of_state_def by (auto simp: image_Un image_comp)

lemma insert_lclss_of_state[simp]:
  "insert (C, New) (lclss_of_state (N, P, Q)) = lclss_of_state (N \<union> {C}, P, Q)"
  "insert (C, Processed) (lclss_of_state (N, P, Q)) = lclss_of_state (N, P \<union> {C}, Q)"
  "insert (C, Old) (lclss_of_state (N, P, Q)) = lclss_of_state (N, P, Q \<union> {C})"
  unfolding lclss_of_state_def image_def by auto

lemma union_lclss_of_state[simp]:
  "lclss_of_state (N1, P1, Q1) \<union> lclss_of_state (N2, P2, Q2) =
   lclss_of_state (N1 \<union> N2, P1 \<union> P2, Q1 \<union> Q2)"
  unfolding lclss_of_state_def by auto

lemma mem_lclss_of_state[simp]:
  "(C, New) \<in> lclss_of_state (N, P, Q) \<longleftrightarrow> C \<in> N"
  "(C, Processed) \<in> lclss_of_state (N, P, Q) \<longleftrightarrow> C \<in> P"
  "(C, Old) \<in> lclss_of_state (N, P, Q) \<longleftrightarrow> C \<in> Q"
  unfolding lclss_of_state_def image_def by auto

lemma lclss_Liminf_commute:
  "Liminf_llist (lmap lclss_of_state Sts) = lclss_of_state (Liminf_state Sts)"
proof -
  have \<open>Liminf_llist (lmap lclss_of_state Sts) =
    (\<lambda>C. (C, New)) ` Liminf_llist (lmap N_of_state Sts) \<union>
    (\<lambda>C. (C, Processed)) ` Liminf_llist (lmap P_of_state Sts) \<union>
    (\<lambda>C. (C, Old)) ` Liminf_llist (lmap Q_of_state Sts)\<close>
    unfolding lclss_of_state_def using Liminf_llist_lmap_union Liminf_llist_lmap_image
    by (smt Pair_inject Un_iff disjoint_iff_not_equal imageE inj_onI label.simps(1,3,5)
        llist.map_cong)
 then show ?thesis
   unfolding lclss_of_state_def Liminf_state_def by auto
qed

lemma GC_tautology_step:
  assumes tauto: "Neg A \<in># C" "Pos A \<in># C"
  shows "lclss_of_state (N \<union> {C}, P, Q) \<leadsto>GC lclss_of_state (N, P, Q)"
proof -
  have c\<theta>_red: "C\<theta> \<in> G.Red_F (\<Union>D \<in> N'. \<G>_F (fst D))" if in_g: "C\<theta> \<in> \<G>_F C"
    for N' :: "('a clause \<times> label) set" and C\<theta>
  proof -
    obtain \<theta> where
      "C\<theta> = C \<cdot> \<theta>"
       using in_g unfolding \<G>_F_def by blast
    then have "Neg (A \<cdot>a \<theta>) \<in># C\<theta>" and "Pos (A \<cdot>a \<theta>) \<in># C\<theta>"
      using tauto Neg_Melem_subst_atm_subst_cls Pos_Melem_subst_atm_subst_cls by auto
    then have "{} \<TTurnstile>e {C\<theta>}"
      unfolding true_clss_def true_cls_def true_lit_def if_distrib_fun
      by (metis literal.disc literal.sel singletonD)
    then show ?thesis
      unfolding G.Red_F_def by auto
  qed

  show ?thesis
  proof (rule FL.step.process[of _ "lclss_of_state (N, P, Q)" "{(C, New)}" _ "{}"])
    show \<open>{(C, New)} \<subseteq> FL.Red_F_\<G> (lclss_of_state (N, P, Q) \<union> {})\<close>
      using mem_FL_Red_F_because_G_Red_F c\<theta>_red[of _ "lclss_of_state (N, P, Q)"]
      unfolding lclss_of_state_def by auto
  qed (auto simp: lclss_of_state_def FL.active_subset_def)
qed

lemma GC_subsumption_step:
  assumes
    d_in: "Dl \<in> N" and
    d_sub_c: "strictly_subsumes (fst Dl) (fst Cl) \<or> subsumes (fst Dl) (fst Cl) \<and> snd Dl \<sqsubset>l snd Cl"
  shows "N \<union> {Cl} \<leadsto>GC N"
proof -
  have d_sub'_c: "Cl \<in> FL.Red_F {Dl} \<or> Dl \<sqsubset> Cl"
  proof (cases "size (fst Dl) = size (fst Cl)")
    case True
      assume sizes_eq: \<open>size (fst Dl) = size (fst Cl)\<close>
      have \<open>size (fst Dl) = size (fst Cl) \<Longrightarrow>
        strictly_subsumes (fst Dl) (fst Cl) \<or> subsumes (fst Dl) (fst Cl) \<and> snd Dl \<sqsubset>l snd Cl \<Longrightarrow>
        Dl \<sqsubset> Cl\<close>
        unfolding FL.Prec_FL_def
        unfolding generalizes_def strictly_generalizes_def strictly_subsumes_def subsumes_def
        by (metis size_subst subset_mset.order_refl subseteq_mset_size_eql)
    then have "Dl \<sqsubset> Cl"
      using sizes_eq d_sub_c by auto
    then show ?thesis
      by (rule disjI2)
  next
    case False
    then have d_ssub_c: "strictly_subsumes (fst Dl) (fst Cl)"
      using d_sub_c unfolding strictly_subsumes_def subsumes_def
      by (metis size_subst strict_subset_subst_strictly_subsumes strictly_subsumes_antisym
          subset_mset.antisym_conv2)
    have "Cl \<in> FL.Red_F {Dl}"
    proof (rule mem_FL_Red_F_because_G_Red_F)
      show \<open>\<forall>D \<in> \<G>_F (fst Cl). D \<in> G.Red_F (\<Union> (\<G>_F ` fst ` {Dl}))\<close>
        using d_ssub_c unfolding G.Red_F_def strictly_subsumes_def subsumes_def \<G>_F_def
      proof clarsimp
        fix \<sigma> \<sigma>'
        assume
          fst_not_in: \<open>\<forall>\<sigma>. \<not> fst Cl \<cdot> \<sigma> \<subseteq># fst Dl\<close> and
          fst_in: \<open>fst Dl \<cdot> \<sigma> \<subseteq># fst Cl\<close> and
          gr_sig: \<open>is_ground_subst \<sigma>'\<close>
        have \<open>{fst Dl \<cdot> \<sigma> \<cdot> \<sigma>'} \<subseteq> {fst Dl \<cdot> \<sigma> |\<sigma>. is_ground_subst \<sigma>}\<close>
          using gr_sig
          by (metis (mono_tags, lifting) is_ground_comp_subst mem_Collect_eq singletonD subsetI
              subst_cls_comp_subst)
        moreover have \<open>\<forall>I. I \<TTurnstile>s {fst Dl \<cdot> \<sigma> \<cdot> \<sigma>'} \<longrightarrow> I \<TTurnstile> fst Cl \<cdot> \<sigma>'\<close>
          using fst_in
          by (meson subst_cls_mono_mset true_clss_insert true_clss_subclause)
        moreover have \<open>\<forall>D \<in> {fst Dl \<cdot> \<sigma> \<cdot> \<sigma>'}. D < fst Cl \<cdot> \<sigma>'\<close>
          using fst_not_in fst_in gr_sig
        proof clarify
          show \<open>\<forall>\<sigma>. \<not> fst Cl \<cdot> \<sigma> \<subseteq># fst Dl \<Longrightarrow> fst Dl \<cdot> \<sigma> \<subseteq># fst Cl \<Longrightarrow> is_ground_subst \<sigma>' \<Longrightarrow>
            fst Dl \<cdot> \<sigma> \<cdot> \<sigma>' < fst Cl \<cdot> \<sigma>'\<close>
            by (metis False size_subst subset_imp_less_mset subset_mset.le_less subst_subset_mono)
        qed
        ultimately show \<open>\<exists>DD \<subseteq> {fst Dl \<cdot> \<sigma> |\<sigma>. is_ground_subst \<sigma>}.
           (\<forall>I. I \<TTurnstile>s DD \<longrightarrow> I \<TTurnstile> fst Cl \<cdot> \<sigma>') \<and> (\<forall>D \<in> DD. D < fst Cl \<cdot> \<sigma>')\<close>
          by blast
      qed
    qed
    then show ?thesis
      by (rule disjI1)
  qed
  show ?thesis
  proof (rule FL.step.process[of _ N "{Cl}" _ "{}"], simp+)
    show \<open>Cl \<in> FL.Red_F_\<G> N\<close>
      using d_sub'_c unfolding FL_Red_F_eq
    proof -
      have \<open>\<And>D. D \<in> \<G>_F (fst Cl) \<Longrightarrow> \<forall>E \<in> N. E \<sqsubset> Cl \<longrightarrow> D \<notin> \<G>_F (fst E) \<Longrightarrow>
        \<forall>D \<in> \<G>_F (fst Cl). D \<in> G.Red_F (\<G>_F (fst Dl)) \<or> Dl \<sqsubset> Cl \<and> D \<in> \<G>_F (fst Dl) \<Longrightarrow>
        D \<in> G.Red_F (\<Union>a \<in> N. \<G>_F (fst a))\<close>
        by (metis (no_types, lifting) G.Red_F_of_subset SUP_upper d_in subset_iff)
      moreover have \<open>\<And>D. D \<in> \<G>_F (fst Cl) \<Longrightarrow> \<forall>E \<in> N. E \<sqsubset> Cl \<longrightarrow> D \<notin> \<G>_F (fst E) \<Longrightarrow> Dl \<sqsubset> Cl \<Longrightarrow>
        D \<in> G.Red_F (\<Union>a \<in> N. \<G>_F (fst a))\<close>
        by (smt FL.Prec_FL_def FL.equiv_F_grounding FL.prec_F_grounding UNIV_witness d_in in_mono)
      ultimately show \<open>Cl \<in> {C. \<forall>D \<in> \<G>_F (fst C). D \<in> G.Red_F (\<Union> (\<G>_F ` fst ` {Dl})) \<or>
        (\<exists>E \<in> {Dl}. E \<sqsubset> C \<and> D \<in> \<G>_F (fst E))} \<or> Dl \<sqsubset> Cl \<Longrightarrow>
        Cl \<in> {C. \<forall>D \<in> \<G>_F (fst C). D \<in> G.Red_F (\<Union> (\<G>_F ` fst ` N)) \<or>
        (\<exists>E \<in> N. E \<sqsubset> C \<and> D \<in> \<G>_F (fst E))}\<close>
        by auto
    qed
  qed (simp add: FL.active_subset_def)
qed

lemma GC_reduction_step:
  assumes
    young: "snd Dl \<noteq> Old" and
    d_sub_c: "fst Dl \<subset># fst Cl"
  shows "N \<union> {Cl} \<leadsto>GC N \<union> {Dl}"
proof (rule FL.step.process[of _ N "{Cl}" _ "{Dl}"])
  have "Cl \<in> FL.Red_F {Dl}"
  proof (rule mem_FL_Red_F_because_G_Red_F)
    show \<open>\<forall>D \<in> \<G>_F (fst Cl). D \<in> G.Red_F (\<Union> (\<G>_F ` fst ` {Dl}))\<close>
      using d_sub_c unfolding G.Red_F_def strictly_subsumes_def subsumes_def \<G>_F_def
    proof clarsimp
      fix \<sigma>
      assume \<open>is_ground_subst \<sigma>\<close>
      then have \<open>{fst Dl \<cdot> \<sigma>} \<subseteq> {fst Dl \<cdot> \<sigma> |\<sigma>. is_ground_subst \<sigma>}\<close>
        by blast
      moreover have \<open>fst Dl \<cdot> \<sigma> < fst Cl \<cdot> \<sigma>\<close>
        using subst_subset_mono[OF d_sub_c, of \<sigma>] by (simp add: subset_imp_less_mset)
      moreover have \<open>\<forall>I. I \<TTurnstile> fst Dl \<cdot> \<sigma> \<longrightarrow> I \<TTurnstile> fst Cl \<cdot> \<sigma>\<close>
        using subst_subset_mono[OF d_sub_c] true_clss_subclause by fast
      ultimately show \<open>\<exists>DD \<subseteq> {fst Dl \<cdot> \<sigma> |\<sigma>. is_ground_subst \<sigma>}. (\<forall>I. I \<TTurnstile>s DD \<longrightarrow> I \<TTurnstile> fst Cl \<cdot> \<sigma>)
        \<and> (\<forall>D \<in> DD. D < fst Cl \<cdot> \<sigma>)\<close>
        by blast
    qed
  qed
  then show "{Cl} \<subseteq> FL.Red_F (N \<union> {Dl})"
    using FL.Red_F_of_subset by blast
qed (auto simp: FL.active_subset_def young)

lemma GC_processing_step: "N \<union> {(C, New)} \<leadsto>GC N \<union> {(C, Processed)}"
proof (rule FL.step.process[of _ N "{(C, New)}" _ "{(C, Processed)}"])
  have "(C, New) \<in> FL.Red_F {(C, Processed)}"
    by (rule mem_FL_Red_F_because_Prec_FL) (simp add: FL.Prec_FL_def generalizes_refl)
  then show "{(C, New)} \<subseteq> FL.Red_F (N \<union> {(C, Processed)})"
    using FL.Red_F_of_subset by blast
qed (auto simp: FL.active_subset_def)

lemma old_inferences_between_eq_new_inferences_between:
  "old_concl_of ` inference_system.inferences_between (ord_FO_\<Gamma> S) N C =
   concl_of ` F.Inf_between N {C}" (is "?rp = ?f")
proof (intro set_eqI iffI)
  fix E
  assume e_in: "E \<in> old_concl_of ` inference_system.inferences_between (ord_FO_\<Gamma> S) N C"

  obtain CAs DA AAs As \<sigma> where
    e_res: "ord_resolve_rename S CAs DA AAs As \<sigma> E" and
    cd_sub: "set CAs \<union> {DA} \<subseteq> N \<union> {C}" and
    c_in: "C \<in> set CAs \<union> {DA}"
    using e_in unfolding inference_system.inferences_between_def infer_from_def ord_FO_\<Gamma>_def by auto

  show "E \<in> concl_of ` F.Inf_between N {C}"
    unfolding F.Inf_between_alt F.Inf_from_def
  proof -
    have \<open>Infer (CAs @ [DA]) E \<in> F_Inf \<and> set (prems_of (Infer (CAs @ [DA]) E)) \<subseteq> insert C N \<and>
      C \<in> set (prems_of (Infer (CAs @ [DA]) E)) \<and> E = concl_of (Infer (CAs @ [DA]) E)\<close>
      using e_res cd_sub c_in F_Inf_def by auto
    then show \<open>E \<in> concl_of ` {\<iota> \<in> F_Inf. \<iota> \<in> {\<iota> \<in> F_Inf. set (prems_of \<iota>) \<subseteq> N \<union> {C}} \<and>
      set (prems_of \<iota>) \<inter> {C} \<noteq> {}}\<close>
      by (smt Un_insert_right boolean_algebra_cancel.sup0 disjoint_insert mem_Collect_eq image_def)
  qed
next
  fix E
  assume e_in: "E \<in> concl_of ` F.Inf_between N {C}"

  obtain CAs DA AAs As \<sigma> where
    e_res: "ord_resolve_rename S CAs DA AAs As \<sigma> E" and
    cd_sub: "set CAs \<union> {DA} \<subseteq> N \<union> {C}" and
    c_in: "C \<in> set CAs \<union> {DA}"
    using e_in unfolding F.Inf_between_alt F.Inf_from_def F_Inf_def inference_system.Inf_between_alt
      inference_system.Inf_from_def
    by (auto simp: image_def Bex_def)

  show "E \<in> old_concl_of ` inference_system.inferences_between (ord_FO_\<Gamma> S) N C"
    unfolding inference_system.inferences_between_def infer_from_def ord_FO_\<Gamma>_def
    using e_res cd_sub c_in
    by (clarsimp simp: image_def Bex_def, rule_tac x = "old_Infer (mset CAs) DA E" in exI, auto)
qed

lemma GC_inference_step:
  assumes
    young: "l \<noteq> Old" and
    no_active: "FL.active_subset M = {}" and
    m_sup: "fst ` M \<supseteq> old_concl_of ` inference_system.inferences_between (ord_FO_\<Gamma> S)
      (fst ` FL.active_subset N) C"
  shows "N \<union> {(C, l)} \<leadsto>GC N \<union> {(C, Old)} \<union> M"
proof (rule FL.step.infer[of _ N C l _ M])
  have m_sup': "fst ` M \<supseteq> concl_of ` F.Inf_between (fst ` FL.active_subset N) {C}"
    using m_sup unfolding old_inferences_between_eq_new_inferences_between .

  show "F.Inf_between (fst ` FL.active_subset N) {C} \<subseteq> F.Red_I (fst ` (N \<union> {(C, Old)} \<union> M))"
  proof
    fix \<iota>
    assume \<iota>_in_if2: "\<iota> \<in> F.Inf_between (fst ` FL.active_subset N) {C}"
    note \<iota>_in = F.Inf_if_Inf_between[OF \<iota>_in_if2]
    have "concl_of \<iota> \<in> fst ` M"
      using m_sup' \<iota>_in_if2 m_sup' by (auto simp: image_def Collect_mono_iff F.Inf_between_alt)
    then have "concl_of \<iota> \<in> fst ` (N \<union> {(C, Old)} \<union> M)"
      by auto
    then show "\<iota> \<in> F.Red_I_\<G> (fst ` (N \<union> {(C, Old)} \<union> M))"
      by (rule F.Red_I_of_Inf_to_N[OF \<iota>_in])
  qed
qed (use young no_active in auto)

lemma RP_step_imp_GC_step: "St \<leadsto>RP St' \<Longrightarrow> lclss_of_state St \<leadsto>GC lclss_of_state St'"
proof (induction rule: RP.induct)
  case (tautology_deletion A C N P Q)
  then show ?case
    by (rule GC_tautology_step)
next
  case (forward_subsumption D P Q C N)
  note d_in = this(1) and d_sub_c = this(2)
  show ?case
  proof (cases "D \<in> P")
    case True
    then show ?thesis
      using GC_subsumption_step[of "(D, Processed)" "lclss_of_state (N, P, Q)" "(C, New)"] d_sub_c
      by auto
  next
    case False
    then have "D \<in> Q"
      using d_in by simp
    then show ?thesis
      using GC_subsumption_step[of "(D, Old)" "lclss_of_state (N, P, Q)" "(C, New)"] d_sub_c by auto
  qed
next
  case (backward_subsumption_P D N C P Q)
  note d_in = this(1) and d_ssub_c = this(2)
  then show ?case
    using GC_subsumption_step[of "(D, New)" "lclss_of_state (N, P, Q)" "(C, Processed)"] d_ssub_c
    by auto
next
  case (backward_subsumption_Q D N C P Q)
  note d_in = this(1) and d_ssub_c = this(2)
  then show ?case
    using GC_subsumption_step[of "(D, New)" "lclss_of_state (N, P, Q)" "(C, Old)"] d_ssub_c by auto
next
  case (forward_reduction D L' P Q L \<sigma> C N)
  show ?case
    using GC_reduction_step[of "(C, New)" "(C + {#L#}, New)" "lclss_of_state (N, P, Q)"] by auto
next
  case (backward_reduction_P D L' N L \<sigma> C P Q)
  show ?case
    using GC_reduction_step[of "(C, Processed)" "(C + {#L#}, Processed)" "lclss_of_state (N, P, Q)"]
    by auto
next
  case (backward_reduction_Q D L' N L \<sigma> C P Q)
  show ?case
    using GC_reduction_step[of "(C, Processed)" "(C + {#L#}, Old)" "lclss_of_state (N, P, Q)"]
    by auto
next
  case (clause_processing N C P Q)
  show ?case
    using GC_processing_step[of "lclss_of_state (N, P, Q)" C] by auto
next
  case (inference_computation N Q C P)
  note n = this(1)
  show ?case
  proof -
    have \<open>FL.active_subset (lclss_of_state (N, {}, {})) = {}\<close>
      unfolding n by (auto simp: FL.active_subset_def)
    moreover have \<open>old_concls_of (inference_system.inferences_between (ord_FO_\<Gamma> S)
      (fst ` FL.active_subset (lclss_of_state ({}, P, Q))) C) \<subseteq> N\<close>
      unfolding n inference_system.inferences_between_def image_def mem_Collect_eq
        lclss_of_state_def infer_from_def
      by (auto simp: FL.active_subset_def)
    ultimately have \<open>lclss_of_state ({}, insert C P, Q) \<leadsto>GC lclss_of_state (N, P, insert C Q)\<close>
      using GC_inference_step[of Processed "lclss_of_state (N, {}, {})"
        "lclss_of_state ({}, P, Q)" C, simplified] by blast
    then show ?case
      by (auto simp: FL.active_subset_def)
  qed
qed

lemma RP_derivation_imp_GC_derivation: "chain (\<leadsto>RP) Sts \<Longrightarrow> chain (\<leadsto>GC) (lmap lclss_of_state Sts)"
  using chain_lmap RP_step_imp_GC_step by blast

lemma RP_step_imp_derive_step: "St \<leadsto>RP St' \<Longrightarrow> lclss_of_state St \<rhd>L lclss_of_state St'"
  by (rule FL.one_step_equiv) (rule RP_step_imp_GC_step)

lemma RP_derivation_imp_derive_derivation:
  "chain (\<leadsto>RP) Sts \<Longrightarrow> chain (\<rhd>L) (lmap lclss_of_state Sts)"
  using chain_lmap RP_step_imp_derive_step by blast

theorem RP_sound_new_statement:
  assumes
    deriv: "chain (\<leadsto>RP) Sts" and
    bot_in: "{#} \<in> clss_of_state (Liminf_state Sts)"
  shows "clss_of_state (lhd Sts) \<TTurnstile>\<G>e {{#}}"
proof -
  have "clss_of_state (Liminf_state Sts) \<TTurnstile>\<G>e {{#}}"
    using F.subset_entailed bot_in by auto
  then have "fst ` Liminf_llist (lmap lclss_of_state Sts) \<TTurnstile>\<G>e {{#}}"
    by (metis image_hd_lclss_of_state lclss_Liminf_commute)
  then have "Liminf_llist (lmap lclss_of_state Sts) \<TTurnstile>\<G>Le FL.Bot_FL"
    using FL.labeled_entailment_lifting by simp
  then have "lhd (lmap lclss_of_state Sts) \<TTurnstile>\<G>Le FL.Bot_FL"
  proof -
    assume \<open>FL.entails_\<G> (Liminf_llist (lmap lclss_of_state Sts)) ({{#}} \<times> UNIV)\<close>
    moreover have \<open>chain (\<rhd>L) (lmap lclss_of_state Sts)\<close>
      using deriv RP_derivation_imp_derive_derivation by simp
    moreover have \<open>chain FL.entails_\<G> (lmap lclss_of_state Sts)\<close>
      by (smt F_entails_\<G>_iff FL.labeled_entailment_lifting RP_model chain_lmap deriv \<G>_Fset_def
        image_hd_lclss_of_state)
    ultimately show \<open>FL.entails_\<G> (lhd (lmap lclss_of_state Sts)) ({{#}} \<times> UNIV)\<close>
      using FL.unsat_limit_iff by blast
  qed
  then have "lclss_of_state (lhd Sts) \<TTurnstile>\<G>Le FL.Bot_FL"
    using chain_not_lnull deriv by fastforce
  then show ?thesis
    unfolding FL.entails_\<G>_L_def F.entails_\<G>_def lclss_of_state_def by auto
qed

theorem RP_saturated_if_fair_new_statement:
  assumes
    deriv: "chain (\<leadsto>RP) Sts" and
    init: "FL.active_subset (lclss_of_state (lhd Sts)) = {}" and
    final: "FL.passive_subset (Liminf_llist (lmap lclss_of_state Sts)) = {}"
  shows "FL.saturated (Liminf_llist (lmap lclss_of_state Sts))"
proof -
  note nnil = chain_not_lnull[OF deriv]
  have gc_deriv: "chain (\<leadsto>GC) (lmap lclss_of_state Sts)"
    by (rule RP_derivation_imp_GC_derivation[OF deriv])
  show ?thesis
    using nnil init final
      FL.fair_implies_Liminf_saturated[OF FL.gc_to_red[OF gc_deriv] FL.gc_fair[OF gc_deriv]] by simp
qed

corollary RP_complete_if_fair_new_statement:
  assumes
    deriv: "chain (\<leadsto>RP) Sts" and
    init: "FL.active_subset (lclss_of_state (lhd Sts)) = {}" and
    final: "FL.passive_subset (Liminf_llist (lmap lclss_of_state Sts)) = {}" and
    unsat: "grounding_of_state (lhd Sts) \<TTurnstile>e {{#}}"
  shows "{#} \<in> Q_of_state (Liminf_state Sts)"
proof -
  note nnil = chain_not_lnull[OF deriv]
  note len = chain_length_pos[OF deriv]
  have gc_deriv: "chain (\<leadsto>GC) (lmap lclss_of_state Sts)"
    by (rule RP_derivation_imp_GC_derivation[OF deriv])

  have hd_lcls: "fst ` lhd (lmap lclss_of_state Sts) = lhd (lmap clss_of_state Sts)"
    using len zero_enat_def by auto
  have hd_unsat: "fst ` lhd (lmap lclss_of_state Sts) \<TTurnstile>\<G>e {{#}}"
    unfolding hd_lcls F_entails_\<G>_iff unfolding true_clss_def using unsat unfolding \<G>_Fset_def
    by (metis (no_types, lifting) chain_length_pos gc_deriv gr.ex_min_counterex i0_less
        llength_eq_0 llength_lmap llength_lmap llist.map_sel(1) true_cls_empty true_clss_singleton)
  have "\<exists>BL \<in> {{#}} \<times> UNIV. BL \<in> Liminf_llist (lmap lclss_of_state Sts)"
    by (rule FL.gc_complete_Liminf[OF gc_deriv,of "{#}"])
      (use final hd_unsat in \<open>auto simp: init nnil\<close>)
  then show ?thesis
    unfolding Liminf_state_def lclss_Liminf_commute
    using final[unfolded FL.passive_subset_def] Liminf_state_def lclss_Liminf_commute by fastforce
qed

subsection \<open>Alternative Derivation of Previous \textsf{RP} Results\<close>

lemma old_fair_imp_new_fair:
  assumes
    nnul: "\<not> lnull Sts" and
    fair: "fair_state_seq Sts" and
    empty_Q0: "Q_of_state (lhd Sts) = {}"
  shows
    "FL.active_subset (lclss_of_state (lhd Sts)) = {}" and
    "FL.passive_subset (Liminf_llist (lmap lclss_of_state Sts)) = {}"
proof -
  show "FL.active_subset (lclss_of_state (lhd Sts)) = {}"
    using nnul empty_Q0 unfolding FL.active_subset_def by (cases Sts) auto
next
  show "FL.passive_subset (Liminf_llist (lmap lclss_of_state Sts)) = {}"
    using fair
    unfolding fair_state_seq_def FL.passive_subset_def lclss_Liminf_commute lclss_of_state_def
    by auto
qed

lemma old_redundant_infer_iff:
  "src.redundant_infer N \<gamma> \<longleftrightarrow>
   (\<exists>DD. DD \<subseteq> N \<and> DD \<union> set_mset (old_side_prems_of \<gamma>) \<TTurnstile>e {old_concl_of \<gamma>}
      \<and> (\<forall>D \<in> DD. D < old_main_prem_of \<gamma>))"
  (is "?lhs \<longleftrightarrow> ?rhs")
proof
  assume ?rhs
  then obtain DD0 where
    "DD0 \<subseteq> N" and
    "DD0 \<union> set_mset (old_side_prems_of \<gamma>) \<TTurnstile>e {old_concl_of \<gamma>}" and
    "\<forall>D \<in> DD0. D < old_main_prem_of \<gamma>"
    by blast
  then obtain DD where
    fin_dd: "finite DD" and
    dd_in: "DD \<subseteq> N" and
    dd_un: "DD \<union> set_mset (old_side_prems_of \<gamma>) \<TTurnstile>e {old_concl_of \<gamma>}" and
    all_dd: "\<forall>D \<in> DD. D < old_main_prem_of \<gamma>"
    using entails_concl_compact_union[of "{old_concl_of \<gamma>}" DD0 "set_mset (old_side_prems_of \<gamma>)"]
    by fast
  show ?lhs
    unfolding src.redundant_infer_def using fin_dd dd_in dd_un all_dd
    by simp (metis finite_set_mset_mset_set true_clss_set_mset)
qed (auto simp: src.redundant_infer_def)

definition old_infer_of :: "'a clause inference \<Rightarrow> 'a old_inference" where
  "old_infer_of \<iota> = old_Infer (mset (side_prems_of \<iota>)) (main_prem_of \<iota>) (concl_of \<iota>)"

lemma new_redundant_infer_imp_old_redundant_infer:
  "G.redundant_infer N \<iota> \<Longrightarrow> src.redundant_infer N (old_infer_of \<iota>)"
  unfolding old_redundant_infer_iff G.redundant_infer_def old_infer_of_def by simp

lemma saturated_imp_saturated_RP:
  assumes
    satur: "FL.saturated (Liminf_llist (lmap lclss_of_state Sts))" and
    no_passive: "FL.passive_subset (Liminf_llist (lmap lclss_of_state Sts)) = {}"
  shows "src.saturated_upto Sts (grounding_of_state (Liminf_state Sts))"
proof -
  define Q where
    "Q = Liminf_llist (lmap Q_of_state Sts)"
  define Ql where
    "Ql = (\<lambda>C. (C, Old)) ` Q"
  define G where
    "G = \<Union> (\<G>_F ` Q)"

  have n_empty: "N_of_state (Liminf_state Sts) = {}" and
    p_empty: "P_of_state (Liminf_state Sts) = {}"
    using no_passive[unfolded FL.passive_subset_def] Liminf_state_def lclss_Liminf_commute
    by fastforce+
  then have limuls_eq: "Liminf_llist (lmap lclss_of_state Sts) = Ql"
    unfolding Ql_def Q_def using Liminf_state_def lclss_Liminf_commute lclss_of_state_def by auto
  have clst_eq: "clss_of_state (Liminf_state Sts) = Q"
    unfolding n_empty p_empty Q_def by (auto simp: Liminf_state_def)
  have gflimuls_eq: "(\<Union>Cl \<in> Ql. \<G>_F (fst Cl)) = G"
    unfolding Ql_def G_def by auto

  have "gd.inferences_from Sts G \<subseteq> src.Ri Sts G"
  proof
    fix \<gamma>
    assume \<gamma>_inf: "\<gamma> \<in> gd.inferences_from Sts G"

    obtain \<iota> where
      \<iota>_inff: "\<iota> \<in> G.Inf_from Q G" and
      \<gamma>: "\<gamma> = old_infer_of \<iota>"
      using \<gamma>_inf
      unfolding gd.inferences_from_def old_infer_from_def G.Inf_from_def old_infer_of_def
    proof (atomize_elim, clarify)
      assume
        g_is: \<open>\<gamma> \<in> gd.ord_\<Gamma> Sts\<close> and
        prems_in: \<open>set_mset (old_side_prems_of \<gamma> + {#old_main_prem_of \<gamma>#}) \<subseteq> G\<close>
      obtain CAs DA AAs As E where main_in: \<open>DA \<in> G\<close> and side_in: \<open>set CAs \<subseteq> G\<close> and
        g_is2: \<open>\<gamma> = old_Infer (mset CAs) DA E\<close> and
        ord_res: \<open>gd.ord_resolve Sts CAs DA AAs As E\<close>
        using g_is prems_in unfolding gd.ord_\<Gamma>_def by auto
      define \<iota>_\<gamma> where "\<iota>_\<gamma> = Infer (CAs @ [DA]) E"
      then have \<open>\<iota>_\<gamma> \<in> G_Inf Q\<close>  using Q_of_state.simps g_is g_is2 ord_res Liminf_state_def S_Q_def
        unfolding gd.ord_\<Gamma>_def G_Inf_def Q_def by auto
      moreover have \<open>set (prems_of \<iota>_\<gamma>) \<subseteq> G\<close>
        using g_is2 prems_in unfolding \<iota>_\<gamma>_def by simp
      moreover have \<open>\<gamma> = old_Infer (mset (side_prems_of \<iota>_\<gamma>)) (main_prem_of \<iota>_\<gamma>) (concl_of \<iota>_\<gamma>)\<close>
        using g_is2 unfolding \<iota>_\<gamma>_def by simp
      ultimately show
        \<open>\<exists>\<iota>. \<iota> \<in> {\<iota> \<in> G_Inf Q. set (prems_of \<iota>) \<subseteq> G} \<and> \<gamma> = old_Infer (mset (side_prems_of \<iota>))
         (main_prem_of \<iota>) (concl_of \<iota>)\<close>
        by blast
    qed
    obtain \<iota>' where
      \<iota>'_inff: "\<iota>' \<in> F.Inf_from Q" and
      \<iota>_in_\<iota>': "\<iota> \<in> \<G>_I Q \<iota>'"
      using G_Inf_overapprox_F_Inf \<iota>_inff unfolding G_def by blast

    note \<iota>'_inf = F.Inf_if_Inf_from[OF \<iota>'_inff]

    let ?olds = "replicate (length (prems_of \<iota>')) Old"

    obtain \<iota>'' and l0 where
      \<iota>'': "\<iota>'' = Infer (zip (prems_of \<iota>') ?olds) (concl_of \<iota>', l0)" and
      \<iota>''_inf: "\<iota>'' \<in> FL.Inf_FL"
      using FL.Inf_F_to_Inf_FL[OF \<iota>'_inf, of ?olds, simplified] by simp

    have "set (prems_of \<iota>'') \<subseteq> Ql"
      using \<iota>'_inff[unfolded F.Inf_from_def, simplified] unfolding \<iota>'' Ql_def by auto
    then have "\<iota>'' \<in> FL.Inf_from Ql"
      unfolding FL.Inf_from_def using \<iota>''_inf by simp
    moreover have "\<iota>' = FL.to_F \<iota>''"
      unfolding \<iota>'' unfolding FL.to_F_def by simp
    ultimately have "\<iota> \<in> G.Red_I Q G"
      using \<iota>_in_\<iota>'
        FL.sat_inf_imp_ground_red_fam_inter[OF satur, unfolded limuls_eq gflimuls_eq, simplified]
      by blast
    then have "G.redundant_infer G \<iota>"
      unfolding G.Red_I_def by auto
    then have \<gamma>_red: "src.redundant_infer G \<gamma>"
      unfolding \<gamma> by (rule new_redundant_infer_imp_old_redundant_infer)
    moreover have "\<gamma> \<in> gd.ord_\<Gamma> Sts"
      using \<gamma>_inf gd.inferences_from_def by blast
    ultimately show "\<gamma> \<in> src.Ri Sts G"
      unfolding src.Ri_def by auto
  qed
  then show ?thesis
    unfolding G_def clst_eq src.saturated_upto_def
    by clarsimp (smt Diff_subset gd.inferences_from_mono subset_eq \<G>_Fset_def)
qed

theorem RP_sound_old_statement:
  assumes
    deriv: "chain (\<leadsto>RP) Sts" and
    bot_in: "{#} \<in> clss_of_state (Liminf_state Sts)"
  shows "\<not> satisfiable (grounding_of_state (lhd Sts))"
  using RP_sound_new_statement[OF deriv bot_in] unfolding F_entails_\<G>_iff \<G>_Fset_def by simp

text \<open>The theorem below is stated differently than the original theorem in \textsf{RP}:
The grounding of the limit might be a strict subset of the limit of the groundings. Because
saturation is neither monotone nor antimonotone, the two results are incomparable. See also
@{thm [source] grounding_of_state_Liminf_state_subseteq}.\<close>

theorem RP_saturated_if_fair_old_statement_altered:
  assumes
    deriv: "chain (\<leadsto>RP) Sts" and
    fair: "fair_state_seq Sts" and
    empty_Q0: "Q_of_state (lhd Sts) = {}"
  shows "src.saturated_upto Sts (grounding_of_state (Liminf_state Sts))"
proof -
  note fair' = old_fair_imp_new_fair[OF chain_not_lnull[OF deriv] fair empty_Q0]
  show ?thesis
    by (rule saturated_imp_saturated_RP[OF _ fair'(2)], rule RP_saturated_if_fair_new_statement)
      (rule deriv fair')+
qed

corollary RP_complete_if_fair_old_statement:
  assumes
    deriv: "chain (\<leadsto>RP) Sts" and
    fair: "fair_state_seq Sts" and
    empty_Q0: "Q_of_state (lhd Sts) = {}" and
    unsat: "\<not> satisfiable (grounding_of_state (lhd Sts))"
  shows "{#} \<in> Q_of_state (Liminf_state Sts)"
proof (rule RP_complete_if_fair_new_statement)
  show \<open>\<G>_Fset (N_of_state (lhd Sts) \<union> P_of_state (lhd Sts) \<union> Q_of_state (lhd Sts)) \<TTurnstile>e {{#}}\<close>
    using unsat unfolding F_entails_\<G>_iff by auto
qed (rule deriv old_fair_imp_new_fair[OF chain_not_lnull[OF deriv] fair empty_Q0])+

end

end


(*  Title:       Deriving class instances for datatypes
    Author:      René Thiemann       <rene.thiemann@uibk.ac.at>
    Maintainer:  René Thiemann
    License:     LGPL
*)

(*
Copyright 2013 René Thiemann

This file is part of IsaFoR/CeTA.

IsaFoR/CeTA is free software: you can redistribute it and/or modify it under the
terms of the GNU Lesser General Public License as published by the Free Software
Foundation, either version 3 of the License, or (at your option) any later
version.

IsaFoR/CeTA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the GNU Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public License along
with IsaFoR/CeTA. If not, see <http://www.gnu.org/licenses/>.
*)

section \<open>Hash functions\<close>

theory Hash_Generator
imports
  Collections.HashCode
  Derive_Aux
begin

subsection "Introduction"

text \<open>
The interface for hash-functions is defined in the class @{class hashable} which has been developed
as part of the Isabelle Collection Framework \cite{rbt}. It requires a hash-function
(@{const hashcode}), a bounded hash-function (@{const bounded_hashcode}),
and a default hash-table size (@{const def_hashmap_size}).

The @{const hashcode} function for each datatype are created by instantiating the recursors of that
datatype appropriately. E.g., for \texttt{datatype 'a test = C1 'a 'a | C2 "'a test list"}
we get a hash-function which is equivalent to
\begin{verbatim}
hashcode (C1 a b) = c1 * hashcode a + c2 * hashcode b
hashcode (C2 Nil) = c3
hashcode (C2 (a # as)) = c4 * hashcode a + c5 * hashcode as
\end{verbatim}
where each \texttt{c$_{i}$} is a non-negative 32-bit number which is dependent on the
datatype name, the constructor name, and the occurrence of the argument (i.e.,
in the example \texttt{c1} and \texttt{c2} will usually be different numbers.)
These parameters are used in linear combination with prime numbers to hopefully
get some useful hash-function.

The @{const bounded_hashcode} functions are constructed in the same way, except that after each
arithmetic operation a modulo operation is performed.

Finally, the default hash-table size is just set to 10, following Java's default
hash-table constructor.
\<close>

subsection "Features and Limitations"

text \<open>
We get same limitation as for the order generator.
For mutual recursive datatypes, only
for the first mentioned datatype the instantiations of the @{class hashable}-class are
derived.
\<close>

subsection "Installing the generator"

lemma hash_mod_lemma: "1 < (n :: nat) \<Longrightarrow> x mod n < n" by auto

ML_file \<open>hash_generator.ML\<close>

end


theory DenotationalEquivalences
imports "Denotational" "HSem-Equivalences"
begin

(* TODO: Replace this by a lemma showing that the equation for Let with update-based semantics
  also holds for HSem (thus showing that either definition would be the equivalent)

lemma sharp_star_Env: "set (bn as) \<sharp>* (\<rho> :: (var f\<rightharpoonup> 'b::{pure_cpo})) \<longleftrightarrow> (\<forall> x \<in> heapVars (asToHeap as) . x \<notin> fdom \<rho>)"
  by(induct rule:asToHeap.induct, auto simp add: fresh_star_def exp_assn.bn_defs fresh_fmap_pure)

theorem HSem_join_update:
  "DenotationalUpd.ESem e \<rho> = Denotational.ESem e \<rho>" and "\<And> e. e \<in> snd ` set (asToHeap as) \<Longrightarrow> DenotationalUpd.ESem e \<rho> = Denotational.ESem e \<rho>"
proof(nominal_induct e and  avoiding: \<rho>  rule:exp_assn.strong_induct)
case (Let as e \<rho>)
  have "fdom \<rho> \<inter> heapVars (asToHeap as) = {}"
    by (metis Let(1) disjoint_iff_not_equal sharp_star_Env)
  hence "DenotationalUpd.UHSem (asToHeap as) \<rho> = Denotational.HSem (asToHeap as) \<rho>"
    by (rule heap_update_join[OF _ "Denotational-PropsUpd.ESem_cont" "Denotational.ESem_cont" Let(2)])
  thus ?case using Let(1,3) by simp
qed (auto dest!: set_mp[OF set_delete_subset])

*)

end


theory Simulation (*TODO: rename, das ist nur fuer AllgemeinesGesetz*)
imports Gesetz Handlung AllgemeinesGesetz
begin

section\<open>Simulation\<close>
text\<open>Gegeben eine handelnde Person und eine Maxime,
wir wollen simulieren was für ein allgemeines Gesetz abgeleitet werden könnte.\<close>

datatype ('person, 'welt, 'a, 'b) simulation_constants = SimConsts
    \<open>'person\<close> \<comment> \<open>handelnde Person\<close>
    \<open>('person, 'welt) maxime\<close>
    \<open>('welt, 'a, 'b) allgemeines_gesetz_ableiten\<close>

    (*moeglich :: H.Handlung world -> Bool, -- brauch ich das oder geht das mit typen?*)

text\<open>...\<close>
(*<*)

text\<open>Simulate one \<^typ>\<open>('person, 'welt) handlungsabsicht\<close> once:\<close>
fun simulate_handlungsabsicht
    :: \<open>('person, 'welt, 'a, 'b) simulation_constants \<Rightarrow>
        ('person, 'welt) handlungsabsicht \<Rightarrow> 'welt \<Rightarrow> (nat, 'a, 'b) gesetz
        \<Rightarrow> ('welt \<times> (nat, 'a, 'b) gesetz)\<close>
  where
    \<open>simulate_handlungsabsicht (SimConsts person maxime aga) ha welt g =
    (let (sollensanordnung, g') = moarlisch_gesetz_ableiten person welt maxime ha aga g in
      let w' = (if sollensanordnung = Erlaubnis
                then
                  nachher (handeln person welt ha)
                else
                  welt
               ) in
      (w', g')
    )\<close>

lemma \<open>simulate_handlungsabsicht
       (SimConsts
          ()
          (Maxime (\<lambda>_ _. True))
          (\<lambda>h s. Rechtsnorm (Tatbestand h) (Rechtsfolge ''count'')))
       (Handlungsabsicht (\<lambda>p w. Some (w+1)))
       (32::int)
       (Gesetz {})=
  (33,
   Gesetz
    {(\<section> (Suc 0), Rechtsnorm (Tatbestand (Handlung 32 33)) (Rechtsfolge ''count''))})\<close>
  by eval

text\<open>Funktion begrenzt oft anwenden bis sich die Welt nicht mehr ändert.
Parameter
 \<^item> Funktion
 \<^item> Maximale Anzahl Iterationen (Simulationen)
 \<^item> Initialwelt
 \<^item> Initialgesetz
\<close>
fun converge
    :: \<open>('welt \<Rightarrow> 'gesetz \<Rightarrow> ('welt \<times> 'gesetz)) \<Rightarrow> nat \<Rightarrow> 'welt \<Rightarrow> 'gesetz \<Rightarrow> ('welt \<times> 'gesetz)\<close>
  where
      \<open>converge _ 0         w g = (w, g)\<close>
    | \<open>converge f (Suc its) w g =
        (let (w', g') = f w g in
          if w = w' then
            (w, g')
          else
            converge f its w' g')\<close>

text\<open>Example: Count 32..42,
      where \<^term>\<open>32::int\<close> is the initial world and we do \<^term>\<open>10::nat\<close> iterations.\<close>
lemma \<open>converge (\<lambda>w g. (w+1, w#g)) 10 (32::int) ([]) =
        (42, [41, 40, 39, 38, 37, 36, 35, 34, 33, 32])\<close> by eval

text\<open>simulate one \<^typ>\<open>('person, 'welt) handlungsabsicht\<close> a few times\<close>
definition simulateOne
    :: \<open>('person, 'welt, 'a, 'b) simulation_constants \<Rightarrow>
        nat \<Rightarrow> ('person, 'welt) handlungsabsicht \<Rightarrow> 'welt \<Rightarrow> (nat, 'a, 'b) gesetz
        \<Rightarrow> (nat, 'a, 'b) gesetz\<close>
    where
    \<open>simulateOne simconsts i ha w g \<equiv>
      let (welt, gesetz) = converge (simulate_handlungsabsicht simconsts ha) i w g in
            gesetz\<close>
(*>*)
text\<open>...
Die Funktion \<^const>\<open>simulateOne\<close> nimmt
eine Konfiguration \<^typ>\<open>('person, 'welt, 'a, 'b) simulation_constants\<close>,
eine Anzahl an Iterationen die durchgeführt werden sollen,
eine Handlung,
eine Initialwelt,
ein Initialgesetz,
und gibt das daraus resultierende Gesetz nach so vielen Iterationen zurück.

Beispiel:
Wir nehmen die mir-ist-alles-egal Maxime.
Wir leiten ein allgemeines Gesetz ab indem wir einfach nur die Handlung wörtlich ins Gesetz
übernehmen.
Wir machen \<^term>\<open>10\<close> Iterationen.
Die Welt ist nur eine Zahl und die initiale Welt sei \<^term>\<open>32\<close>.
Die Handlung ist es diese Zahl um Eins zu erhöhen,
Das Ergebnis der Simulation ist dann, dass wir einfach von \<^term>\<open>32\<close> bis \<^term>\<open>42\<close> zählen.\<close>
lemma \<open>simulateOne
        (SimConsts () (Maxime (\<lambda>_ _. True)) (\<lambda>h s. Rechtsnorm (Tatbestand h) (Rechtsfolge ''count'')))
        10 (Handlungsabsicht (\<lambda>p n. Some (Suc n)))
        32
        (Gesetz {}) =
  Gesetz
  {(\<section> 10, Rechtsnorm (Tatbestand (Handlung 41 42)) (Rechtsfolge ''count'')),
   (\<section> 9, Rechtsnorm (Tatbestand (Handlung 40 41)) (Rechtsfolge ''count'')),
   (\<section> 8, Rechtsnorm (Tatbestand (Handlung 39 40)) (Rechtsfolge ''count'')),
   (\<section> 7, Rechtsnorm (Tatbestand (Handlung 38 39)) (Rechtsfolge ''count'')),
   (\<section> 6, Rechtsnorm (Tatbestand (Handlung 37 38)) (Rechtsfolge ''count'')),
   (\<section> 5, Rechtsnorm (Tatbestand (Handlung 36 37)) (Rechtsfolge ''count'')),
   (\<section> 4, Rechtsnorm (Tatbestand (Handlung 35 36)) (Rechtsfolge ''count'')),
   (\<section> 3, Rechtsnorm (Tatbestand (Handlung 34 35)) (Rechtsfolge ''count'')),
   (\<section> 2, Rechtsnorm (Tatbestand (Handlung 33 34)) (Rechtsfolge ''count'')),
   (\<section> 1, Rechtsnorm (Tatbestand (Handlung 32 33)) (Rechtsfolge ''count''))}\<close>
  by eval

text\<open>Eine Iteration der Simulation liefert genau einen Paragraphen im Gesetz:\<close>
lemma \<open>\<exists>tb rf.
  simulateOne
    (SimConsts person maxime gesetz_ableiten)
    1 handlungsabsicht
    initialwelt
    (Gesetz {})
  = Gesetz {(\<section> 1, Rechtsnorm (Tatbestand tb) (Rechtsfolge rf))}\<close>
  apply(simp add: simulateOne_def moarlisch_gesetz_ableiten_def)
  apply(case_tac \<open>maxime\<close>, simp)
  apply(simp add: moralisch_unfold max_paragraph_def)
  apply(intro conjI impI)
  by(metis rechtsfolge.exhaust rechtsnorm.exhaust tatbestand.exhaust)+
end


(*
    Author:   Benedikt Seidl
    License:  BSD
*)

section \<open>The Master Theorem\<close>

theory Master_Theorem
imports
  Advice After
begin

subsection \<open>Checking @{term "X \<subseteq> \<G>\<F> \<phi> w"} and @{term "Y \<subseteq> \<F>\<G> \<phi> w"}\<close>

lemma X_\<G>\<F>_Y_\<F>\<G>:
  assumes
    X_\<mu>: "X \<subseteq> subformulas\<^sub>\<mu> \<phi>"
  and
    Y_\<nu>: "Y \<subseteq> subformulas\<^sub>\<nu> \<phi>"
  and
    X_GF: "\<forall>\<psi> \<in> X. w \<Turnstile>\<^sub>n G\<^sub>n (F\<^sub>n \<psi>[Y]\<^sub>\<mu>)"
  and
    Y_FG: "\<forall>\<psi> \<in> Y. w \<Turnstile>\<^sub>n F\<^sub>n (G\<^sub>n \<psi>[X]\<^sub>\<nu>)"
  shows
    "X \<subseteq> \<G>\<F> \<phi> w \<and> Y \<subseteq> \<F>\<G> \<phi> w"
proof -
  \<comment> \<open>Custom induction rule with @{term size} as a partial order\<close>
  note induct = finite_ranking_induct[where f = size]

  have "finite (X \<union> Y)"
    using subformulas\<^sub>\<mu>_finite subformulas\<^sub>\<nu>_finite X_\<mu> Y_\<nu> finite_subset
    by blast+

  then show ?thesis
    using assms
  proof (induction "X \<union> Y" arbitrary: X Y \<phi> rule: induct)
    case (insert \<psi> S)

    note IH = insert(3)
    note insert_S = `insert \<psi> S = X \<union> Y`
    note X_\<mu> = `X \<subseteq> subformulas\<^sub>\<mu> \<phi>`
    note Y_\<nu> = `Y \<subseteq> subformulas\<^sub>\<nu> \<phi>`
    note X_GF = `\<forall>\<psi> \<in> X. w \<Turnstile>\<^sub>n G\<^sub>n (F\<^sub>n \<psi>[Y]\<^sub>\<mu>)`
    note Y_FG = `\<forall>\<psi> \<in> Y. w \<Turnstile>\<^sub>n F\<^sub>n (G\<^sub>n \<psi>[X]\<^sub>\<nu>)`

    from X_\<mu> Y_\<nu> have "X \<inter> Y = {}"
      using subformulas\<^sub>\<mu>\<^sub>\<nu>_disjoint by fast

    from insert_S X_\<mu> Y_\<nu> have "\<psi> \<in> subfrmlsn \<phi>"
      using subformulas\<^sub>\<mu>_subfrmlsn subformulas\<^sub>\<nu>_subfrmlsn by blast

    show ?case
    proof (cases "\<psi> \<notin> S", cases "\<psi> \<in> X")
      assume "\<psi> \<notin> S" and "\<psi> \<in> X"

      {
        \<comment> \<open>Show @{term "X - {\<psi>} \<subseteq> \<G>\<F> \<phi> w"} and @{term "Y \<subseteq> \<F>\<G> \<phi> w"}\<close>

        then have "\<psi> \<notin> Y"
          using `X \<inter> Y = {}` by auto
        then have "S = (X - {\<psi>}) \<union> Y"
          using insert_S `\<psi> \<notin> S` by fast

        moreover

        have "\<forall>\<psi>' \<in> Y. \<psi>'[X - {\<psi>}]\<^sub>\<nu> = \<psi>'[X]\<^sub>\<nu>"
          using GF_advice_minus_size insert(1,2,4) `\<psi> \<notin> Y` by fast

        ultimately have "X - {\<psi>} \<subseteq> \<G>\<F> \<phi> w" and "Y \<subseteq> \<F>\<G> \<phi> w"
          using IH[of "X - {\<psi>}" Y \<phi>] X_\<mu> Y_\<nu> X_GF Y_FG by auto
      }

      moreover

      {
        \<comment> \<open>Show @{term "\<psi> \<in> \<G>\<F> \<phi> w"}\<close>

        have "w \<Turnstile>\<^sub>n G\<^sub>n (F\<^sub>n \<psi>[Y]\<^sub>\<mu>)"
          using X_GF `\<psi> \<in> X` by simp
        then have "\<exists>\<^sub>\<infinity>i. suffix i w \<Turnstile>\<^sub>n \<psi>[Y]\<^sub>\<mu>"
          unfolding GF_Inf_many by simp

        moreover

        from Y_\<nu> have "finite Y"
          using subformulas\<^sub>\<nu>_finite finite_subset by auto

        have "\<forall>\<phi> \<in> Y. w \<Turnstile>\<^sub>n F\<^sub>n (G\<^sub>n \<phi>)"
          using `Y \<subseteq> \<F>\<G> \<phi> w` by (blast dest: \<F>\<G>_elim)
        then have "\<forall>\<phi> \<in> Y. \<forall>\<^sub>\<infinity>i. suffix i w \<Turnstile>\<^sub>n G\<^sub>n \<phi>"
          using FG_suffix_G by blast
        then have "\<forall>\<^sub>\<infinity>i. \<forall>\<phi> \<in> Y. suffix i w \<Turnstile>\<^sub>n G\<^sub>n \<phi>"
          using `finite Y` eventually_ball_finite by fast

        ultimately

        have "\<exists>\<^sub>\<infinity>i. suffix i w \<Turnstile>\<^sub>n \<psi>[Y]\<^sub>\<mu> \<and> (\<forall>\<phi> \<in> Y. suffix i w \<Turnstile>\<^sub>n G\<^sub>n \<phi>)"
          using INFM_conjI by auto
        then have "\<exists>\<^sub>\<infinity>i. suffix i w \<Turnstile>\<^sub>n \<psi>"
          by (elim frequently_elim1) (metis FG_advice_b2_helper)
        then have "w \<Turnstile>\<^sub>n G\<^sub>n (F\<^sub>n \<psi>)"
          unfolding GF_Inf_many by simp
        then have "\<psi> \<in> \<G>\<F> \<phi> w"
          unfolding \<G>\<F>_semantics using `\<psi> \<in> X` X_\<mu> by auto
      }

      ultimately show ?thesis
        by auto
    next
      assume "\<psi> \<notin> S" and "\<psi> \<notin> X"
      then have "\<psi> \<in> Y"
        using insert by fast

      {
        \<comment> \<open>Show @{term "X \<subseteq> \<G>\<F> \<phi> w"} and @{term "Y - {\<psi>} \<subseteq> \<F>\<G> \<phi> w"}\<close>

        then have "S \<inter> X = X"
          using insert `\<psi> \<notin> X` by fast
        then have "S = X \<union> (Y - {\<psi>})"
          using insert_S `\<psi> \<notin> S` by fast

        moreover

        have "\<forall>\<psi>' \<in> X. \<psi>'[Y - {\<psi>}]\<^sub>\<mu> = \<psi>'[Y]\<^sub>\<mu>"
          using FG_advice_minus_size insert(1,2,4) `\<psi> \<notin> X` by fast

        ultimately have "X \<subseteq> \<G>\<F> \<phi> w" and "Y - {\<psi>} \<subseteq> \<F>\<G> \<phi> w"
          using IH[of X "Y - {\<psi>}" \<phi>] X_\<mu> Y_\<nu> X_GF Y_FG by auto
      }

      moreover

      {
        \<comment> \<open>Show @{term "\<psi> \<in> \<F>\<G> \<phi> w"}\<close>

        have "w \<Turnstile>\<^sub>n F\<^sub>n (G\<^sub>n \<psi>[X]\<^sub>\<nu>)"
          using Y_FG `\<psi> \<in> Y` by simp
        then have "\<forall>\<^sub>\<infinity>i. suffix i w \<Turnstile>\<^sub>n \<psi>[X]\<^sub>\<nu>"
          unfolding FG_Alm_all by simp

        moreover

        have "\<forall>\<phi> \<in> X. w \<Turnstile>\<^sub>n G\<^sub>n (F\<^sub>n \<phi>)"
          using `X \<subseteq> \<G>\<F> \<phi> w` by (blast dest: \<G>\<F>_elim)
        then have "\<forall>\<^sub>\<infinity>i. \<forall>\<phi> \<in> X. suffix i w \<Turnstile>\<^sub>n G\<^sub>n (F\<^sub>n \<phi>)"
          by simp

        ultimately

        have "\<forall>\<^sub>\<infinity>i. suffix i w \<Turnstile>\<^sub>n \<psi>[X]\<^sub>\<nu> \<and> (\<forall>\<phi> \<in> X. suffix i w \<Turnstile>\<^sub>n G\<^sub>n (F\<^sub>n \<phi>))"
          using MOST_conjI by auto
        then have "\<forall>\<^sub>\<infinity>i. suffix i w \<Turnstile>\<^sub>n \<psi>"
          by (elim MOST_mono) (metis GF_advice_a2_helper)
        then have "w \<Turnstile>\<^sub>n F\<^sub>n (G\<^sub>n \<psi>)"
          unfolding FG_Alm_all by simp
        then have "\<psi> \<in> \<F>\<G> \<phi> w"
          unfolding \<F>\<G>_semantics using `\<psi> \<in> Y` Y_\<nu> by auto
      }

      ultimately show ?thesis
        by auto
    next
      assume "\<not> \<psi> \<notin> S"
      then have "S = X \<union> Y"
        using insert by fast
      then show ?thesis
        using insert by auto
    qed
  qed fast
qed

lemma \<G>\<F>_implies_GF:
  "\<forall>\<psi> \<in> \<G>\<F> \<phi> w. w \<Turnstile>\<^sub>n G\<^sub>n (F\<^sub>n \<psi>[\<F>\<G> \<phi> w]\<^sub>\<mu>)"
proof safe
  fix \<psi>
  assume "\<psi> \<in> \<G>\<F> \<phi> w"

  then have "\<exists>\<^sub>\<infinity>i. suffix i w \<Turnstile>\<^sub>n \<psi>"
    using \<G>\<F>_elim GF_Inf_many by blast

  moreover

  have "\<psi> \<in> subfrmlsn \<phi>"
    using `\<psi> \<in> \<G>\<F> \<phi> w` \<G>\<F>_subfrmlsn by blast

  then have "\<And>i w. \<F>\<G> \<psi> (suffix i w) \<subseteq> \<F>\<G> \<phi> w"
    using \<F>\<G>_suffix \<F>\<G>_subset by blast

  ultimately have "\<exists>\<^sub>\<infinity>i. suffix i w \<Turnstile>\<^sub>n \<psi>[\<F>\<G> \<phi> w]\<^sub>\<mu>"
    by (elim frequently_elim1) (metis FG_advice_b1)

  then show "w \<Turnstile>\<^sub>n G\<^sub>n (F\<^sub>n \<psi>[\<F>\<G> \<phi> w]\<^sub>\<mu>)"
    unfolding GF_Inf_many by simp
qed

lemma \<F>\<G>_implies_FG:
  "\<forall>\<psi> \<in> \<F>\<G> \<phi> w. w \<Turnstile>\<^sub>n F\<^sub>n (G\<^sub>n \<psi>[\<G>\<F> \<phi> w]\<^sub>\<nu>)"
proof safe
  fix \<psi>
  assume "\<psi> \<in> \<F>\<G> \<phi> w"

  then have "\<forall>\<^sub>\<infinity>i. suffix i w \<Turnstile>\<^sub>n \<psi>"
    using \<F>\<G>_elim FG_Alm_all by blast

  moreover

  {
    have "\<psi> \<in> subfrmlsn \<phi>"
      using `\<psi> \<in> \<F>\<G> \<phi> w` \<F>\<G>_subfrmlsn by blast

    moreover have "\<forall>\<^sub>\<infinity>i. \<G>\<F> \<psi> (suffix i w) = \<F> \<psi> (suffix i w)"
      using suffix_\<mu>_stable unfolding \<mu>_stable_def by blast

    ultimately have "\<forall>\<^sub>\<infinity>i. \<F> \<psi> (suffix i w) \<subseteq> \<G>\<F> \<phi> w"
      unfolding MOST_nat_le by (metis \<G>\<F>_subset \<G>\<F>_suffix)
  }

  ultimately have "\<forall>\<^sub>\<infinity>i. \<F> \<psi> (suffix i w) \<subseteq> \<G>\<F> \<phi> w \<and> suffix i w \<Turnstile>\<^sub>n \<psi>"
    using eventually_conj by auto

  then have "\<forall>\<^sub>\<infinity>i. suffix i w \<Turnstile>\<^sub>n \<psi>[\<G>\<F> \<phi> w]\<^sub>\<nu>"
    using GF_advice_a1 by (elim eventually_mono) auto

  then show "w \<Turnstile>\<^sub>n F\<^sub>n (G\<^sub>n \<psi>[\<G>\<F> \<phi> w]\<^sub>\<nu>)"
    unfolding FG_Alm_all by simp
qed

subsection \<open>Putting the pieces together: The Master Theorem\<close>

theorem master_theorem_ltr:
  assumes
    "w \<Turnstile>\<^sub>n \<phi>"
  obtains X and Y where
    "X \<subseteq> subformulas\<^sub>\<mu> \<phi>"
  and
    "Y \<subseteq> subformulas\<^sub>\<nu> \<phi>"
  and
    "\<exists>i. suffix i w \<Turnstile>\<^sub>n af \<phi> (prefix i w)[X]\<^sub>\<nu>"
  and
    "\<forall>\<psi> \<in> X. w \<Turnstile>\<^sub>n G\<^sub>n (F\<^sub>n \<psi>[Y]\<^sub>\<mu>)"
  and
    "\<forall>\<psi> \<in> Y. w \<Turnstile>\<^sub>n F\<^sub>n (G\<^sub>n \<psi>[X]\<^sub>\<nu>)"
proof
  show "\<G>\<F> \<phi> w \<subseteq> subformulas\<^sub>\<mu> \<phi>"
    by (rule \<G>\<F>_subformulas\<^sub>\<mu>)
next
  show "\<F>\<G> \<phi> w \<subseteq> subformulas\<^sub>\<nu> \<phi>"
    by (rule \<F>\<G>_subformulas\<^sub>\<nu>)
next
  obtain i where "\<G>\<F> \<phi> (suffix i w) = \<F> \<phi> (suffix i w)"
    using suffix_\<mu>_stable unfolding MOST_nat \<mu>_stable_def by fast
  then have "\<F> (af \<phi> (prefix i w)) (suffix i w) \<subseteq> \<G>\<F> \<phi> w"
    using \<G>\<F>_af \<F>_af \<G>\<F>_suffix by fast

  moreover

  have "suffix i w \<Turnstile>\<^sub>n af \<phi> (prefix i w)"
    using af_ltl_continuation `w \<Turnstile>\<^sub>n \<phi>` by fastforce

  ultimately show "\<exists>i. suffix i w \<Turnstile>\<^sub>n af \<phi> (prefix i w)[\<G>\<F> \<phi> w]\<^sub>\<nu>"
    using GF_advice_a1 by blast
next
  show "\<forall>\<psi> \<in> \<G>\<F> \<phi> w. w \<Turnstile>\<^sub>n G\<^sub>n (F\<^sub>n \<psi>[\<F>\<G> \<phi> w]\<^sub>\<mu>)"
    by (rule \<G>\<F>_implies_GF)
next
  show "\<forall>\<psi> \<in> \<F>\<G> \<phi> w. w \<Turnstile>\<^sub>n F\<^sub>n (G\<^sub>n \<psi>[\<G>\<F> \<phi> w]\<^sub>\<nu>)"
    by (rule \<F>\<G>_implies_FG)
qed

theorem master_theorem_rtl:
  assumes
    "X \<subseteq> subformulas\<^sub>\<mu> \<phi>"
  and
    "Y \<subseteq> subformulas\<^sub>\<nu> \<phi>"
  and
    1: "\<exists>i. suffix i w \<Turnstile>\<^sub>n af \<phi> (prefix i w)[X]\<^sub>\<nu>"
  and
    2: "\<forall>\<psi> \<in> X. w \<Turnstile>\<^sub>n G\<^sub>n (F\<^sub>n \<psi>[Y]\<^sub>\<mu>)"
  and
    3: "\<forall>\<psi> \<in> Y. w \<Turnstile>\<^sub>n F\<^sub>n (G\<^sub>n \<psi>[X]\<^sub>\<nu>)"
  shows
    "w \<Turnstile>\<^sub>n \<phi>"
proof -
  from 1 obtain i where "suffix i w \<Turnstile>\<^sub>n af \<phi> (prefix i w)[X]\<^sub>\<nu>"
    by blast

  moreover

  from assms have "X \<subseteq> \<G>\<F> \<phi> w"
    using X_\<G>\<F>_Y_\<F>\<G> by blast
  then have "X \<subseteq> \<G>\<F> \<phi> (suffix i w)"
    using \<G>\<F>_suffix by fast

  ultimately have "suffix i w \<Turnstile>\<^sub>n af \<phi> (prefix i w)"
    using GF_advice_a2 \<G>\<F>_af by metis
  then show "w \<Turnstile>\<^sub>n \<phi>"
    using af_ltl_continuation by force
qed

theorem master_theorem:
  "w \<Turnstile>\<^sub>n \<phi> \<longleftrightarrow>
    (\<exists>X \<subseteq> subformulas\<^sub>\<mu> \<phi>.
      (\<exists>Y \<subseteq> subformulas\<^sub>\<nu> \<phi>.
        (\<exists>i. suffix i w \<Turnstile>\<^sub>n af \<phi> (prefix i w)[X]\<^sub>\<nu>)
        \<and> (\<forall>\<psi> \<in> X. w \<Turnstile>\<^sub>n G\<^sub>n (F\<^sub>n \<psi>[Y]\<^sub>\<mu>))
        \<and> (\<forall>\<psi> \<in> Y. w \<Turnstile>\<^sub>n F\<^sub>n (G\<^sub>n \<psi>[X]\<^sub>\<nu>))))"
  by (metis master_theorem_ltr master_theorem_rtl)

subsection \<open>The Master Theorem on Languages\<close>

definition "L\<^sub>1 \<phi> X = {w. \<exists>i. suffix i w \<Turnstile>\<^sub>n af \<phi> (prefix i w)[X]\<^sub>\<nu>}"

definition "L\<^sub>2 X Y = {w. \<forall>\<psi> \<in> X. w \<Turnstile>\<^sub>n G\<^sub>n (F\<^sub>n \<psi>[Y]\<^sub>\<mu>)}"

definition "L\<^sub>3 X Y = {w. \<forall>\<psi> \<in> Y. w \<Turnstile>\<^sub>n F\<^sub>n (G\<^sub>n \<psi>[X]\<^sub>\<nu>)}"

corollary master_theorem_language:
  "language_ltln \<phi> = \<Union> {L\<^sub>1 \<phi> X \<inter> L\<^sub>2 X Y \<inter> L\<^sub>3 X Y | X Y. X \<subseteq> subformulas\<^sub>\<mu> \<phi> \<and> Y \<subseteq> subformulas\<^sub>\<nu> \<phi>}"
proof safe
  fix w
  assume "w \<in> language_ltln \<phi>"

  then have "w \<Turnstile>\<^sub>n \<phi>"
    unfolding language_ltln_def by simp

  then obtain X Y where "X \<subseteq> subformulas\<^sub>\<mu> \<phi>" and "Y \<subseteq> subformulas\<^sub>\<nu> \<phi>"
    and "\<exists>i. suffix i w \<Turnstile>\<^sub>n af \<phi> (prefix i w)[X]\<^sub>\<nu>"
    and "\<forall>\<psi> \<in> X. w \<Turnstile>\<^sub>n G\<^sub>n (F\<^sub>n \<psi>[Y]\<^sub>\<mu>)"
    and "\<forall>\<psi> \<in> Y. w \<Turnstile>\<^sub>n F\<^sub>n (G\<^sub>n \<psi>[X]\<^sub>\<nu>)"
    using master_theorem_ltr by metis

  then have "w \<in> L\<^sub>1 \<phi> X" and "w \<in> L\<^sub>2 X Y" and "w \<in> L\<^sub>3 X Y"
    unfolding L\<^sub>1_def L\<^sub>2_def L\<^sub>3_def by simp+

  then show "w \<in> \<Union> {L\<^sub>1 \<phi> X \<inter> L\<^sub>2 X Y \<inter> L\<^sub>3 X Y | X Y. X \<subseteq> subformulas\<^sub>\<mu> \<phi> \<and> Y \<subseteq> subformulas\<^sub>\<nu> \<phi>}"
    using `X \<subseteq> subformulas\<^sub>\<mu> \<phi>` `Y \<subseteq> subformulas\<^sub>\<nu> \<phi>` by blast
next
  fix w X Y
  assume "X \<subseteq> subformulas\<^sub>\<mu> \<phi>" and "Y \<subseteq> subformulas\<^sub>\<nu> \<phi>"
    and "w \<in> L\<^sub>1 \<phi> X" and "w \<in> L\<^sub>2 X Y" and "w \<in> L\<^sub>3 X Y"

  then show "w \<in> language_ltln \<phi>"
    unfolding language_ltln_def L\<^sub>1_def L\<^sub>2_def L\<^sub>3_def
    using master_theorem_rtl by blast
qed

end