Theory Modular_Splitting_Calculus

(* Title:        Formalizing an abstract calculus based on splitting in a modular way
 * Authors:      Ghilain Bergeron <ghilain.bergeron at inria.fr>, 2023
 *               Sophie Tourret <sophie.tourret at inria.fr>, 2024 *)

theory Modular_Splitting_Calculus
  imports
    Calculi_And_Annotations
    Light_Lifting_to_Non_Ground_Calculi
    List_Extra
    FSet_Extra
begin


section ‹Core splitting calculus›
                                                                                          
text ‹
  In this section, we formalize an abstract version of a splitting calculus.
  We start by considering only two basic rules:
   \textsc{Base} performs an inference from our inference system;
   \textsc{Unsat} replaces a set of prosopositionally unsatisfiable formulas with ⊥›.
›

locale annotated_calculus = calculus_with_annotated_consrel bot FInf entails entails_sound FRedI 
  FRedF fml asn
  for bot :: 'f and
      FInf :: 'f inference set and
      entails :: [ 'f set, 'f set ]  bool (infix  50) and
      entails_sound :: [ 'f set, 'f set ]  bool (infix ⊨s 50) and
      FRedI :: 'f set  'f inference set and
      FRedF :: 'f set  'f set and
      fml :: 'v :: countable  'f and
      asn :: 'f sign  'v sign set 
  + assumes
      (* D6 *)
      entails_nontrivial: ¬ {}  {} and
      (* R5 *)
      reducedness: Inf_between UNIV (FRedF N)  FRedI N and
      (* R6 *)
      complete: bot  FRedF N and
      (* R7 *)
      all_red_to_bot: 𝒞  bot  𝒞  FRedF {bot}
begin

notation sound_cons.entails_neg (infix ⊨s 50) 

subsection ‹The inference rules›

text ‹
  Every inference rule $X$ is defined using two functions: $X\_pre$ and $X\_inf$.
  $X\_inf$ is the inference rule itself, while $X\_pre$ are side-conditions for
  the rule to be applicable.
›

abbreviation base_pre :: ('f, 'v) AF list  'f  bool where
  base_pre 𝒩 D  Infer (map F_of 𝒩) D  FInf

abbreviation base_inf :: ('f, 'v) AF list  'f  ('f, 'v) AF inference where
  base_inf 𝒩 D  Infer 𝒩 (Pair D (ffUnion (fset_of_list (map A_of 𝒩))))

abbreviation unsat_pre :: ('f, 'v) AF list  bool where
  unsat_pre 𝒩  ( x  set 𝒩. F_of x = bot)  propositionally_unsatisfiable (set 𝒩)

abbreviation unsat_inf :: ('f, 'v) AF list  ('f, 'v) AF inference where
  unsat_inf 𝒩  Infer 𝒩 (to_AF bot)

text ‹
  We consider first only the inference rules \textsc{Base} and \textsc{Unsat}. The optional 
  inference and simplification rules are handled separately in the locales 
  splitting_calculus_extensions› and splitting_calculus_with_simps› respectively.
›

inductive_set SInf :: ('f, 'v) AF inference set where
  base: base_pre 𝒩 D  base_inf 𝒩 D  SInf
| unsat: unsat_pre 𝒩  unsat_inf 𝒩  SInf 

text ‹
  The predicates in @{term Splitting_rules} form a valid inference system.
›
interpretation SInf_inf_system: inference_system SInf .

lemma not_empty_entails_bot: ¬{}  {bot}
  using entails_bot_to_entails_empty entails_nontrivial
  by blast

text ‹
  The proof for Lemma 13 is split into two parts, for each inclusion in the set equality.
›

(* Report lemma 13 1/2 *)
lemma SInf_commutes_Inf1:
  bot  𝒩 projJ J  (inference_system.Inf_from SInf 𝒩) ιprojJ J  Inf_from (𝒩 projJ J)
proof (intro subsetI)
  fix ιS
  assume bot_not_in_proj: bot  𝒩 projJ J and
         ιS_is_inf: ιS  (inference_system.Inf_from SInf 𝒩) ιprojJ J

  have no_enabled_prop_clause_in_𝒩:  𝒞  𝒩. enabled 𝒞 J  F_of 𝒞  bot
    using bot_not_in_proj
    unfolding enabled_projection_def
    by blast

  obtain ιF where ιS_is: ιS = ιF_of ιF and
                 ιF_is_inf: ιF  inference_system.Inf_from SInf 𝒩 and
                 ιF_is_enabled: enabled_inf ιF J
    using ιS_is_inf enabled_projection_Inf_def
    by auto
  then have ιF_in_S: ιF  SInf
    by (simp add: inference_system.Inf_from_def)
  moreover have prems_of_ιF_subset_𝒩: set (prems_of ιF)  𝒩
    using ιF_is_inf
    by (simp add: inference_system.Inf_from_def)
  moreover have ιF_of ιF  FInf
    unfolding ιF_of_def
    using ιF_in_S
  proof (cases ιF rule: SInf.cases)
    case (base 𝒩 D)
    then show base_pre (prems_of ιF) (F_of (concl_of ιF))
      by auto
  next
    case (unsat 𝒩)
    moreover have enabled_inf ιF J
      using ιF_is_enabled
      by fastforce
    then have  𝒞  set 𝒩. F_of 𝒞  bot
      by (metis enabled_inf_def inference.sel(1) local.unsat(1) no_enabled_prop_clause_in_𝒩
           prems_of_ιF_subset_𝒩 subset_eq)
    then have False
      using not_empty_entails_bot unsat(2) enabled_projection_def prop_proj_in
        propositional_model_def propositionally_unsatisfiable_def by auto
    ultimately show base_pre (prems_of ιF) (F_of (concl_of ιF))
      by blast
  qed
  moreover have set (prems_of (ιF_of ιF))  𝒩 projJ J
    using ιF_is_enabled prems_of_ιF_subset_𝒩
    by (auto simp add: enabled_inf_def enabled_projection_def ιF_of_def)
  ultimately have ιF_of ιF  Inf_from (𝒩 projJ J)
    by (simp add: Inf_from_def)
  then show ιS  Inf_from (𝒩 projJ J)
    by (simp add: ιS_is)
qed

(* Report lemma 13 2/2 *)
lemma SInf_commutes_Inf2:
  bot  𝒩 projJ J  Inf_from (𝒩 projJ J)  (inference_system.Inf_from SInf 𝒩) ιprojJ J
proof (intro subsetI)
  fix ιF
  assume bot_not_in_proj: bot  𝒩 projJ J and
         ιF_in_inf: ιF  Inf_from (𝒩 projJ J)

  have ιF_is_Inf: ιF  FInf
    using Inf_if_Inf_from ιF_in_inf
    by blast
  have set (prems_of ιF)  𝒩 projJ J
    using Inf_from_def ιF_in_inf
    by blast
  then have  𝒞  set (prems_of ιF).  A. Pair 𝒞 A  𝒩  enabled (Pair 𝒞 A) J
    by (smt (verit, ccfv_SIG) AF.collapse enabled_projection_def mem_Collect_eq subsetD)
  then have list_all (λ 𝒞.  A. Pair 𝒞 A  𝒩  enabled (Pair 𝒞 A) J) (prems_of ιF)
    using Ball_set
    by blast
  then obtain As where
      length_As_is_length_prems_ιF: length (prems_of ιF) = length As and
      As_def:  (C, A)  set (zip (prems_of ιF) As). Pair C A  𝒩  enabled (Pair C A) J
    by (smt (verit, del_insts) Ball_set_list_all list_all2_iff list_all_exists_is_exists_list_all2)
  define ιS where
    ιS  Infer [ Pair 𝒞 A. (𝒞, A)  zip (prems_of ιF) As ]
                (Pair (concl_of ιF) (ffUnion (fset_of_list As)))
  have ιF_is_Inf2: Infer (map F_of [ Pair 𝒞 A. (𝒞, A)  zip (prems_of ιF) As ]) (concl_of ιF)  FInf
    using length_As_is_length_prems_ιF
    by (auto simp add: ιF_is_Inf)
  then have ιS_is_SInf: ιS  SInf
    using SInf.base[OF ιF_is_Inf2] length_As_is_length_prems_ιF
    unfolding ιS_def
    by auto
  moreover have set (prems_of ιS)  𝒩
    unfolding ιS_def
    using As_def
    by auto
  then have ιS  inference_system.Inf_from SInf 𝒩
    using inference_system.Inf_from_def ιS_is_SInf
    by blast
  moreover have ιF_of ιS = ιF
    unfolding ιS_def ιF_of_def
    by (simp add: length_As_is_length_prems_ιF)
  moreover have enabled_inf ιS J
    unfolding enabled_inf_def ιS_def
    using As_def
    by auto
  ultimately have  ι'. ιF = ιF_of ι'  ι'  inference_system.Inf_from SInf 𝒩  enabled_inf ι' J
    by blast
  then show ιF  (inference_system.Inf_from SInf 𝒩) ιprojJ J
    unfolding enabled_projection_Inf_def
    by simp
qed

text ‹
  We use @{thm SInf_commutes_Inf1} and @{thm SInf_commutes_Inf2} to put the Lemma 13
  together into a single proof.
›

(* Report lemma 13 *)
lemma SInf_commutes_Inf:
  bot  𝒩 projJ J  (inference_system.Inf_from SInf 𝒩) ιprojJ J = Inf_from (𝒩 projJ J)
  using SInf_commutes_Inf1 SInf_commutes_Inf2
  by blast

(* Report theorem 14 for the cases Base and Unsat *)
theorem SInf_sound_wrt_entails_sound: ιS  SInf  set (prems_of ιS) ⊨sAF {concl_of ιS}
proof -
  assume ιS  SInf
  then show set (prems_of ιS) ⊨sAF {concl_of ιS}
  proof (cases ιS rule: SInf.cases)
    case (base 𝒩 D)
    assume base_pre 𝒩 D
    then have inf_is_sound: set (map F_of 𝒩) ⊨s {D}
      using sound
      by fastforce
    then show ?thesis
      unfolding AF_entails_sound_def sound_cons.entails_neg_def
    proof (intro allI impI)
      fix J
      assume enabled_set {concl_of ιS} J
      then have Pair_D_A_of_𝒩_is_enabled: enabled_set {concl_of ιS} J
        using base
        by simp
      then have F_of ` {concl_of ιS} = {D}
        using base
        by simp
      moreover have fset (ffUnion (fset_of_list (map A_of 𝒩)))  total_strip J
        using Pair_D_A_of_𝒩_is_enabled
        unfolding enabled_set_def enabled_def
        by (simp add: local.base(1))
      then have fBall (fset_of_list (map A_of 𝒩)) (λ As. fset As  total_strip J)
        using fset_ffUnion_subset_iff_all_fsets_subset
        by fast
      then have  As  set (map A_of 𝒩). fset As  total_strip J
        by (meson fset_of_list_elem)
      then have  𝒞  set 𝒩. enabled 𝒞 J
        unfolding enabled_def
        by simp
      then have set 𝒩 projJ J = F_of ` set 𝒩
        unfolding enabled_projection_def
        by auto
      moreover have {C. Pos C  fml_ext ` total_strip J  Pos ` F_of ` set 𝒩} ⊨s {D}
        using inf_is_sound
       by (smt (verit, ccfv_threshold) UnCI imageI list.set_map mem_Collect_eq
            sound_cons.entails_subsets subsetI)  
      moreover have {C. Neg C  Pos ` F_of ` {concl_of ιS}} = {}
        by fast
      ultimately show {C. Pos C  fml_ext ` total_strip J  Pos ` (set (prems_of ιS) projJ J)} 
                       {C. Neg C  Pos ` F_of ` {concl_of ιS}} ⊨s
                       {C. Pos C  Pos ` F_of ` {concl_of ιS}} 
                       {C. Neg C  fml_ext ` total_strip J  Pos ` (set (prems_of ιS) projJ J)}
        using base
        by (smt (verit, del_insts) UnCI imageI inference.sel(1) inference.sel(2) mem_Collect_eq
             sound_cons.entails_subsets subsetI)
    qed
  next
    case (unsat 𝒩)
    assume pre_cond: unsat_pre 𝒩
    then have heads_of_𝒩_are_bot:  x  set 𝒩. F_of x = bot and
              𝒩_is_prop_unsat: propositionally_unsatisfiable (set 𝒩)
      by blast+
    then have proj (set 𝒩) = set 𝒩
      using heads_of_𝒩_are_bot propositional_projection_def
      by blast
    then have  J. bot  (set 𝒩) projJ J
      using 𝒩_is_prop_unsat propositional_model_def propositionally_unsatisfiable_def
      by force
    then show ?thesis
      unfolding AF_entails_sound_def sound_cons.entails_neg_def
      using unsat
      by auto
         (smt (verit) Un_insert_right insertI1 insert_absorb sound_cons.bot_entails_empty
          sound_cons.entails_subsets subsetI sup_bot_right)  
  qed
qed

text ‹The lifted calculus provides a consequence relation and a sound inference system.›
interpretation AF_sound_cons_rel: consequence_relation to_AF bot (⊨sAF)
  by (rule AF_ext_sound_cons_rel)

interpretation SInf_sound_inf_system: sound_inference_system SInf to_AF bot (⊨sAF)
  by (standard, auto simp add: SInf_sound_wrt_entails_sound)


subsection ‹The redundancy criterion›

(* Report definition 15: splitting redundancy criterion *)
definition SRedF :: ('f, 'v) AF set  ('f, 'v) AF set where
  SRedF 𝒩 = { AF.Pair C A | C A.  𝒥. total_strip 𝒥  fset A  C  FRedF (𝒩 projJ 𝒥) }
             { AF.Pair C A | C A.  𝒞  𝒩. F_of 𝒞 = C  A_of 𝒞 |⊂| A }

definition SRedI :: ('f, 'v) AF set  ('f, 'v) AF inference set where
  SRedI 𝒩 = { base_inf  𝒞 |  𝒞. base_pre  𝒞 
                 ( 𝒥. { base_inf  𝒞 } ιprojJ 𝒥  FRedI (𝒩 projJ 𝒥)) }
            { unsat_inf  | . unsat_pre   to_AF bot  𝒩 }

(* Report lemma 16 *)
lemma sredI_𝒩_proj_J_subset_redI_proj_J: to_AF bot  𝒩  (SRedI 𝒩) ιprojJ J  FRedI (𝒩 projJ J)
proof -
  assume to_AF bot  𝒩
  then have SRedI_𝒩_is:
    SRedI 𝒩 = { base_inf  𝒞 |  𝒞. base_pre  𝒞 
                   ( 𝒥. {base_inf  𝒞} ιprojJ 𝒥  FRedI (𝒩 projJ 𝒥)) }
    using SRedI_def
    by auto
  then show (SRedI 𝒩) ιprojJ J  FRedI (𝒩 projJ J)
  proof (cases (SRedI 𝒩) ιprojJ J = {})
    case True
    then show ?thesis
      by fast
  next
    case False
    then obtain ιS where ιS  SRedI 𝒩
      using enabled_projection_Inf_def
      by fastforce
    then have {ιS} ιprojJ J  FRedI (𝒩 projJ J)
      using SRedI_𝒩_is
      by auto
    then show ?thesis
      using SRedI_𝒩_is enabled_projection_Inf_def
      by force
  qed
qed

(* Report lemma 17 *)
lemma bot_not_in_sredF_𝒩: to_AF bot  SRedF 𝒩
proof -
  have to_AF bot  { AF.Pair C A | C A.  𝒥. total_strip 𝒥  fset A  C  FRedF (𝒩 projJ 𝒥) }
    by (simp add: complete to_AF_def)
  moreover have to_AF bot  { AF.Pair C A | C A.  𝒞  𝒩. F_of 𝒞 = C  A_of 𝒞 |⊂| A }
    by (simp add: to_AF_def)
  moreover have to_AF bot  { AF.Pair C A | C A.  J. ¬ fset A  total_strip J }
    by (simp add: to_AF_def)
  ultimately show ?thesis
    using SRedF_def
    by auto
qed

text ‹
  We need to set things up for the proof of lemma 18.
  We first restrict @{const SRedI} to \textsc{Base} inferences (under the name ARedI) and show
  that it is a redundancy criterion.
  And then we consider the case of \textsc{Unsat} inferences separately.
›

definition ARedF :: ('f, 'v) AF set  ('f, 'v) AF set where
  ARedF 𝒩  SRedF 𝒩

definition ARedI :: ('f, 'v) AF set  ('f, 'v) AF inference set where
  ARedI 𝒩  { base_inf  𝒞 |  𝒞. base_pre  𝒞 
                  ( 𝒥. { base_inf  𝒞 } ιprojJ 𝒥  FRedI (𝒩 projJ 𝒥)) }

definition AInf :: ('f, 'v) AF inference set where
  AInf  { base_inf 𝒩 D | 𝒩 D. base_pre 𝒩 D }

definition 𝒢F :: 'v total_interpretation  ('f, 'v) AF  'f set where
  𝒢F 𝒥 𝒞  {𝒞} projJ 𝒥

definition 𝒢I :: 'v total_interpretation  ('f, 'v) AF inference  'f inference set where
  𝒢I 𝒥 ι  {ι} ιprojJ 𝒥

text ‹We define a wellfounded ordering on A-formulas to strengthen @{const ARedI}.
  Basically, A ← 𝒞 ⊐ A ← 𝒞'› if 𝒞 ⊂ 𝒞'›.› 

definition tiebreaker_order :: ('f, 'v :: countable) AF rel where
  tiebreaker_order  { (𝒞, 𝒞'). F_of 𝒞 = F_of 𝒞'  A_of 𝒞 |⊂| A_of 𝒞' }

abbreviation sqsupset_is_tiebreaker_order (infix  50) where
  𝒞  𝒞'  (𝒞, 𝒞')  tiebreaker_order

lemma tiebreaker_order_is_strict_partial_order: po_on (⊐) UNIV
  unfolding po_on_def irreflp_on_def transp_on_def tiebreaker_order_def
  by auto

lemma wfp_on_fsubset: wfp_on (|⊂|) UNIV
  using wf_fsubset
  by auto

lemma wfp_on_tiebreaker_order: wfp_on (⊐) (UNIV :: ('f, 'v) AF set)
  unfolding wfp_on_def
proof (intro notI)
  assume  f.  i. f i  UNIV  f (Suc i)  f i
  then obtain f where f_is:  i. f i  UNIV  f (Suc i)  f i
    by auto
  define f' where f' = (λ i. A_of (f i))

  have  i. f' i  UNIV  f' (Suc i) |⊂| f' i
    using f_is
    unfolding f'_def tiebreaker_order_def
    by auto
  then show False
    using wfp_on_fsubset
    unfolding wfp_on_def
    by blast
qed

text ‹We can lift inferences from FRedI to ARedI.›
interpretation lift_from_FRed_to_ARed: light_tiebreaker_lifting {to_AF bot} AInf {bot} (⊨∩)
  FInf FRedI FRedF 𝒢F 𝒥 Some  𝒢I 𝒥 λ_. (⊐)
proof (standard)
  fix N
  show FRedI N  FInf
    using Red_I_to_Inf
    by presburger
next
  fix B N
  assume B  {bot} and
         N ⊨∩ {B}
  then show N - FRedF N ⊨∩ {B}
    using Red_F_Bot consequence_relation.entails_conjunctive_def consequence_relation_axioms
    by fastforce
next
  fix N N' :: 'f set
  assume N  N'
  then show FRedF N  FRedF N'
    using Red_F_of_subset
    by presburger
next
  fix N N' :: 'f set
  assume N  N'
  then show FRedI N  FRedI N'
    using Red_I_of_subset
    by presburger
next
  fix N N'
  assume N'  FRedF N
  then show FRedF N  FRedF (N - N')
    using Red_F_of_Red_F_subset
    by presburger
next
  fix N N'
  assume N'  FRedF N
  then show FRedI N  FRedI (N - N')
    using Red_I_of_Red_F_subset
    by presburger
next
  fix ι N
  assume ι  FInf and
         concl_of ι  N
  then show ι  FRedI N
    using Red_I_of_Inf_to_N
    by blast
next
  show {to_AF bot}  {}
    by fast
next
  fix B :: ('f, 'v) AF
  assume B  {to_AF bot}
  then show 𝒢F 𝒥 B  {}
    by (simp add: 𝒢F_def enabled_def enabled_projection_def to_AF_def)
next
  fix B :: ('f, 'v) AF
  assume B  {to_AF bot}
  then show 𝒢F 𝒥 B  {bot}
    using 𝒢F_def enabled_projection_def
    by (auto simp add: F_of_to_AF) 
next
  fix ιA
  assume ιA_is_ainf: ιA  AInf and
         (Some  𝒢I 𝒥) ιA  None
  have 𝒢I 𝒥 ιA  FRedI (𝒢F 𝒥 (concl_of ιA))
  proof (intro subsetI)
    fix x
    assume x_in_𝒢I_of_ιA: x  𝒢I 𝒥 ιA
    then obtain 𝒩 D where ιA_is: ιA = base_inf 𝒩 D and
                           infer_𝒩_D_is_inf: base_pre 𝒩 D
      using AInf_def ιA_is_ainf
      by auto
    moreover have ιA_is_enabled: enabled_inf ιA 𝒥 and
                  x_is: x = ιF_of ιA
      using 𝒢I_def enabled_projection_Inf_def x_in_𝒢I_of_ιA
      by auto
    then have prems_of ιA = 𝒩
      using ιA_is
      by auto
    then have fBall (fset_of_list (map A_of 𝒩)) (λ As. fset As  total_strip 𝒥)
      using ιA_is ιA_is_enabled
      unfolding enabled_inf_def enabled_def
      by (simp add: fBall_fset_of_list_iff_Ball_set)
    then have fset (ffUnion (A_of |`| fset_of_list 𝒩))  total_strip 𝒥
      by (simp add: fset_ffUnion_subset_iff_all_fsets_subset)
    then have enabled (AF.Pair D (ffUnion (A_of |`| fset_of_list 𝒩))) 𝒥
      unfolding enabled_def
      by auto
    then have {AF.Pair D (ffUnion (fset_of_list (map A_of 𝒩)))} projJ 𝒥 = {D}
      unfolding enabled_projection_def F_of_def
      using ιA_is_enabled ιA_is
      by auto
    then have x  FRedI (𝒢F 𝒥 (Pair D (ffUnion (fset_of_list (map A_of 𝒩)))))
      using x_in_𝒢I_of_ιA ιA_is_enabled x_is infer_𝒩_D_is_inf ιA_is
      unfolding 𝒢I_def 𝒢F_def ιF_of_def
      by (simp add: Red_I_of_Inf_to_N)
    then show x  FRedI (𝒢F 𝒥 (concl_of ιA))
      by (simp add: ιA_is)
  qed
  then show the ((Some  𝒢I 𝒥) ιA)  FRedI (𝒢F 𝒥 (concl_of ιA))
    by simp
next
  fix g
  show po_on (⊐) UNIV
    using tiebreaker_order_is_strict_partial_order
    by blast
next
  fix g
  show wfp_on (⊐) UNIV
    using wfp_on_tiebreaker_order
    by blast
qed

lemma ARedI_is_FRedI: ARedI 𝒩 = ( J. lift_from_FRed_to_ARed.Red_I_𝒢 J 𝒩)
proof (intro subset_antisym subsetI)
  fix ι
  assume ι  ARedI 𝒩
  then obtain  𝒞 where ι_is: ι = base_inf  𝒞 and
                         Infer_ℳ_𝒞_in_Inf: base_pre  𝒞 and
                         ι_in_FRedI:  𝒥. { base_inf  𝒞 } ιprojJ 𝒥  FRedI (𝒩 projJ 𝒥)
    using ARedI_def
    by fastforce
  then have ι_is_AInf: ι  AInf
    using AInf_def
    by blast
  then have  J. {ι} ιprojJ J  FRedI ( (𝒢F J ` 𝒩))
    unfolding 𝒢F_def
    using ι_in_FRedI ι_is Union_of_enabled_projection_is_enabled_projection
    by auto
  then have  J. ι  lift_from_FRed_to_ARed.Red_I_𝒢 J 𝒩
    using ι_is_AInf
    unfolding lift_from_FRed_to_ARed.Red_I_𝒢_def 𝒢I_def
    by auto
  then show ι  ( J. lift_from_FRed_to_ARed.Red_I_𝒢 J 𝒩)
    by blast
next
  fix ι
  assume ι_in_FRedI_𝒢: ι  ( J. lift_from_FRed_to_ARed.Red_I_𝒢 J 𝒩)
  then have ι_is_AInf: ι  AInf and
            all_J_𝒢I_subset_FRedI:  J. 𝒢I J ι  FRedI ( (𝒢F J ` 𝒩))
    unfolding lift_from_FRed_to_ARed.Red_I_𝒢_def
    by auto
  then obtain  𝒞 where ι_is: ι = base_inf  𝒞 and
                         Infer_ℳ_𝒞_is_Inf: base_pre  𝒞
    using AInf_def
    by auto
  then obtain ιF where ιF_is: ιF = ιF_of ι
    by auto
  then have   𝒞. ι = base_inf  𝒞  base_pre  𝒞 
               ( 𝒥. { base_inf  𝒞 } ιprojJ 𝒥  FRedI (𝒩 projJ 𝒥))
    using ι_is Infer_ℳ_𝒞_is_Inf all_J_𝒢I_subset_FRedI
    unfolding 𝒢I_def 𝒢F_def
    using Union_of_enabled_projection_is_enabled_projection
    by fastforce
  then show ι  ARedI 𝒩
    unfolding ARedI_def
    by auto
qed

(* Check that ARedF and FRedF∩𝒢,⊐ coincide *)
lemma ARedF_is_FRedF: ARedF 𝒩 = ( J. lift_from_FRed_to_ARed.Red_F_𝒢 J 𝒩)
proof (intro subset_antisym subsetI)
  fix 𝒞
  assume 𝒞_in_ARedF: 𝒞  ARedF 𝒩
  then obtain C A where 𝒞_is: 𝒞 = AF.Pair C A
    unfolding ARedF_def SRedF_def
    by blast
  consider (a)  𝒥. fset A  total_strip 𝒥  C  FRedF (𝒩 projJ 𝒥) |
           (b)  𝒞  𝒩. F_of 𝒞 = C  A_of 𝒞 |⊂| A
    using 𝒞_in_ARedF 𝒞_is
    unfolding ARedF_def SRedF_def
    by blast
  then show 𝒞  ( J. lift_from_FRed_to_ARed.Red_F_𝒢 J 𝒩)
    unfolding lift_from_FRed_to_ARed.Red_F_𝒢_def
  proof (cases)
    case a
    then have  J.  D  𝒢F J 𝒞. D  FRedF ( (𝒢F J ` 𝒩))
      unfolding RedF_strict_def 𝒢F_def
      using Union_of_enabled_projection_is_enabled_projection 𝒞_is enabled_projection_def
            𝒞_is complete enabled_projection_def
      using enabled_def
      by force
    then have 𝒞  ( J. { C.  D  𝒢F J C. D  FRedF ( (𝒢F J ` 𝒩)) })
      by blast
    then show 𝒞  ( J. { C.  D  𝒢F J C. D  FRedF ( (𝒢F J ` 𝒩)) 
                              ( E  𝒩. E  C  D  𝒢F J E) })
      by blast
  next
    case b
    then have  J.  D  𝒢F J 𝒞.  E  𝒩. E  𝒞  D  𝒢F J E
      unfolding 𝒢F_def tiebreaker_order_def enabled_projection_def
      using subformula_of_enabled_formula_is_enabled
      (* /!\ Careful, a bit slow (∼ 1s) /!\ *)
      by (smt (verit, ccfv_SIG) AF.sel(1) AF.sel(2) 𝒞_is case_prodI mem_Collect_eq
           singletonD singletonI)
    then have 𝒞  ( J. { C.  D  𝒢F J C.  E  𝒩. E  C  D  𝒢F J E })
      by blast
    then show 𝒞  ( J. { C.  D  𝒢F J C. D  FRedF ( (𝒢F J ` 𝒩)) 
                              ( E  𝒩. E  C  D  𝒢F J E) })
      by blast
  qed
next
  fix 𝒞
  assume 𝒞_in_FRedF_𝒢: 𝒞  ( J. lift_from_FRed_to_ARed.Red_F_𝒢 J 𝒩)
  then have 𝒞_in_FRedF_𝒢_unfolded:
     J.  D  𝒢F J 𝒞. D  FRedF ( (𝒢F J ` 𝒩))  ( E  𝒩. E  𝒞  D  𝒢F J E)
    unfolding lift_from_FRed_to_ARed.Red_F_𝒢_def
    by blast
  then have 𝒞_in_FRedF_𝒢_if_enabled:
     J. enabled 𝒞 J  F_of 𝒞  FRedF ( (𝒢F J ` 𝒩))  ( E  𝒩. E  𝒞  F_of 𝒞  𝒢F J E)
    unfolding 𝒢F_def enabled_projection_def
    by auto
  obtain C A where 𝒞_is: 𝒞 = AF.Pair C A
    by (meson AF.exhaust_sel)
  then have
     J. fset A  total_strip J 
      C  FRedF ( (𝒢F J ` 𝒩))  ( E  𝒩. E  𝒞  C  𝒢F J E)
    using 𝒞_in_FRedF_𝒢_if_enabled
    unfolding enabled_def
    by simp
  then show 𝒞  ARedF 𝒩
    using 𝒞_is 𝒞_in_FRedF_𝒢_if_enabled
    unfolding ARedF_def SRedF_def 𝒢F_def enabled_def tiebreaker_order_def
    using Union_of_enabled_projection_is_enabled_projection
    by auto
qed

(* Check that both ⊨AF and ⊨𝒢 coincide *)
lemma entails_is_entails_𝒢:  AF {𝒞}  ( 𝒥. lift_from_FRed_to_ARed.entails_𝒢 𝒥  {𝒞})
proof (intro iffI allI)
  fix 𝒥
  assume  AF {𝒞}
  then show lift_from_FRed_to_ARed.entails_𝒢 𝒥  {𝒞}
    unfolding 𝒢F_def AF_entails_def enabled_projection_def enabled_set_def entails_conjunctive_def
    by (simp add: Union_of_singleton_is_setcompr)
next
  assume entails_𝒢_ℳ_𝒞:  𝒥. lift_from_FRed_to_ARed.entails_𝒢 𝒥  {𝒞}
  show  AF {𝒞}
    unfolding 𝒢F_def AF_entails_def enabled_set_def
    proof (intro allI impI)
      fix J
      assume  𝒞  {𝒞}. enabled 𝒞 J
      then show  projJ J  F_of ` {𝒞}
        using entails_𝒢_ℳ_𝒞
        unfolding 𝒢F_def enabled_projection_def entails_conjunctive_def
        by (simp add: Union_of_singleton_is_setcompr)
    qed
qed

(* We put here a collection of useful lemmas when deriving facts about SInf, SRedI and SRedF. *)

lemma SRedI_in_SInf: SRedI N  SInf
  using SRedI_def SInf.simps
  by force

lemma SRedF_entails_bot: N AF {to_AF bot}  N - SRedF N AF {to_AF bot}
proof -
  fix N

  have And_to_Union:
     J. N - lift_from_FRed_to_ARed.Red_F_𝒢 J N  ( J. N - lift_from_FRed_to_ARed.Red_F_𝒢 J N)
    by blast

  assume N_entails_bot: N AF {to_AF bot}
  have lift_from_FRed_to_ARed.entails_𝒢 J N {to_AF bot} 
         lift_from_FRed_to_ARed.entails_𝒢 J (N - lift_from_FRed_to_ARed.Red_F_𝒢 J N) {to_AF bot}
    for J
    using lift_from_FRed_to_ARed.Red_F_Bot_F
    by blast
  then have N AF {to_AF bot}  N - ARedF N AF {to_AF bot}
  proof -
    assume N AF {to_AF bot} and
            J. lift_from_FRed_to_ARed.entails_𝒢 J N {to_AF bot} 
            lift_from_FRed_to_ARed.entails_𝒢 J (N - lift_from_FRed_to_ARed.Red_F_𝒢 J N) {to_AF bot}
    then have FRedF_𝒢_entails_𝒢_bot:
      lift_from_FRed_to_ARed.entails_𝒢 J (N - lift_from_FRed_to_ARed.Red_F_𝒢 J N) {to_AF bot}
      for J
      using entails_is_entails_𝒢
      by blast
    then have
      lift_from_FRed_to_ARed.entails_𝒢 J ( J. N - lift_from_FRed_to_ARed.Red_F_𝒢 J N) {to_AF bot}
      for J
      using And_to_Union
      by (meson lift_from_FRed_to_ARed.entails_trans lift_from_FRed_to_ARed.subset_entailed)
    then show N - ARedF N AF {to_AF bot}
      using ARedF_is_FRedF entails_is_entails_𝒢
      by fastforce
  qed
  then show N - SRedF N AF {to_AF bot}
    using ARedF_def N_entails_bot
    by force
qed

lemma SRedF_of_subset_F: N  N'  SRedF N  SRedF N'
proof -
  fix N N' :: ('f, 'v) AF set
  assume N  N'
  then show SRedF N  SRedF N'
    unfolding SRedF_def enabled_projection_def
    (* /!\ Takes a bit of time /!\ *)
    by auto
      (smt (verit, best) Collect_mono Red_F_of_subset subset_iff)
qed

lemma SRedI_of_subset_F: N  N'  SRedI N  SRedI N'
proof -
  fix N N' :: ('f, 'v) AF set
  assume N  N'
  then show SRedI N  SRedI N'
    unfolding SRedI_def enabled_projection_Inf_def enabled_projection_def enabled_inf_def ιF_of_def
    (* /!\ This is a bit slow (between 5 and 10s), but this works... /!\ *)
    by (auto, (smt (verit, best) Red_I_of_subset mem_Collect_eq subset_iff)+)
qed

lemma SRedF_of_SRedF_subset_F: N'  SRedF N  SRedF N  SRedF (N - N')
proof -
  fix N N'
  assume N'_subset_SRedF_N: N'  SRedF N
  have N'  ARedF N  ARedF N  ARedF (N - N')
    using lift_from_FRed_to_ARed.Red_F_of_Red_F_subset_F
  proof -
    assume N'_subset_ARedF_N: N'  ARedF N and
           ( N' 𝒥 N. N'  lift_from_FRed_to_ARed.Red_F_𝒢 𝒥 N 
              lift_from_FRed_to_ARed.Red_F_𝒢 𝒥 N  lift_from_FRed_to_ARed.Red_F_𝒢 𝒥 (N - N'))
    then have  N' N. N'  ( 𝒥. lift_from_FRed_to_ARed.Red_F_𝒢 𝒥 N) 
                  ( 𝒥. lift_from_FRed_to_ARed.Red_F_𝒢 𝒥 N) 
                    ( 𝒥. lift_from_FRed_to_ARed.Red_F_𝒢 𝒥 (N - N'))
      by (meson INF_mono' UNIV_I le_INF_iff)
    then show ARedF N  ARedF (N - N')
      using ARedF_is_FRedF N'_subset_ARedF_N
      by presburger
  qed
  then show SRedF N  SRedF (N - N')
    by (simp add: ARedF_def N'_subset_SRedF_N)
qed

lemma SRedI_of_SRedF_subset_F: N'  SRedF N  SRedI N  SRedI (N - N')
proof -
  fix N N'
  assume N'_subset_SRedF_N: N'  SRedF N
  have works_for_ARedI: N'  ARedF N  ARedI N  ARedI (N - N')
    using lift_from_FRed_to_ARed.Red_I_of_Red_F_subset_F
  proof -
    assume N'_subset_ARedF_N: N'  ARedF N and
           ( N' 𝒥 N. N'  lift_from_FRed_to_ARed.Red_F_𝒢 𝒥 N 
               lift_from_FRed_to_ARed.Red_I_𝒢 𝒥 N  lift_from_FRed_to_ARed.Red_I_𝒢 𝒥 (N - N'))
    then have  N' N. N'  ( 𝒥. lift_from_FRed_to_ARed.Red_F_𝒢 𝒥 N) 
                  ( 𝒥. lift_from_FRed_to_ARed.Red_I_𝒢 𝒥 N) 
                    ( 𝒥. lift_from_FRed_to_ARed.Red_I_𝒢 𝒥 (N - N'))
      by (metis (no_types, lifting) INF_mono' UNIV_I le_INF_iff)
    then show ARedI N  ARedI (N - N')
      using ARedI_is_FRedI ARedF_is_FRedF N'_subset_ARedF_N
      by presburger
  qed
  moreover have unsat_pre 𝒩  unsat_inf 𝒩  SRedI (N - N') 
    if ι_is_redundant: unsat_inf 𝒩  SRedI N
    for 𝒩
    using bot_not_in_sredF_𝒩 N'_subset_SRedF_N ι_is_redundant
    unfolding SRedI_def SRedF_def
    (* /!\ Quite slow... /!\ *)
    by (smt (verit, del_insts) ARedF_def ARedI_def Diff_iff N'_subset_SRedF_N Un_iff
         bot_not_in_sredF_𝒩 works_for_ARedI mem_Collect_eq subsetD)
  ultimately show SRedI N  SRedI (N - N')
    using N'_subset_SRedF_N bot_not_in_sredF_𝒩
    unfolding SRedF_def ARedF_def SRedI_def ARedI_def
    (* /!\ A bit slow /!\ *)
    by (smt (verit, del_insts) Collect_cong Diff_iff N'_subset_SRedF_N Un_iff
         bot_not_in_sredF_𝒩 subset_iff)
qed

lemma SRedI_of_SInf_to_N_F: ιS  SInf  concl_of ιS  N  ιS  SRedI N
proof -
  fix ιS N
  assume ιS  SInf and
         concl_ιS_in_N: concl_of ιS  N
  then show ιS  SRedI N
    unfolding SRedI_def
  proof (cases ιS rule: SInf.cases)
    case (base 𝒩 D)
    obtain  𝒞 where ιS_is: ιS = base_inf  𝒞 and
                      Infer_ℳ_𝒞_is_Inf: base_pre  𝒞
      using base
      by blast
    have  J. { base_inf  𝒞 } ιprojJ J  FRedI (N projJ J)
      unfolding enabled_projection_Inf_def enabled_projection_def ιF_of_def enabled_inf_def
    proof (intro allI subsetI)
      fix J
      have 𝒞set . enabled 𝒞 J  Infer (map F_of ) 𝒞  FRedI {F_of 𝒞 |𝒞. 𝒞  N  enabled 𝒞 J}
      proof -
        assume all_enabled_in_ℳ:  𝒞  set . enabled 𝒞 J
        then have A_of_ℳ_to_𝒞_in_N: AF.Pair 𝒞 (ffUnion (fset_of_list (map A_of )))  N
          using ιS_is concl_ιS_in_N
          by auto
        moreover have fBall (fset_of_list ) (λ x. fset (A_of x)  total_strip J)
          using all_enabled_in_ℳ
          unfolding enabled_def
          by (simp add: fset_of_list_elem)
        then have fBall (A_of |`| fset_of_list ) (λ x. fset x  total_strip J)
          by auto
        then have enabled (AF.Pair 𝒞 (ffUnion (A_of |`| fset_of_list ))) J
          using A_of_ℳ_to_𝒞_in_N
          unfolding enabled_def
          using fset_ffUnion_subset_iff_all_fsets_subset
          by (metis AF.sel(2))
        ultimately show Infer (map F_of ) 𝒞  FRedI {F_of 𝒞 | 𝒞. 𝒞  N  enabled 𝒞 J}
          by (metis (mono_tags, lifting) AF.sel(1) Infer_ℳ_𝒞_is_Inf Red_I_of_Inf_to_N
               fset_of_list_map inference.sel(2) mem_Collect_eq)
      qed
      then show x  {Infer (map F_of (prems_of ι)) (F_of (concl_of ι)) |ι.
                ι  {base_inf  𝒞}  (𝒞set (prems_of ι). enabled 𝒞 J)} 
           x  FRedI {F_of 𝒞 |𝒞. 𝒞  N  enabled 𝒞 J} for x
        by simp
    qed
    then have ιS  { base_inf  𝒞 |  𝒞. base_pre  𝒞 
                        ( 𝒥. { base_inf  𝒞 } ιprojJ 𝒥  FRedI (N projJ 𝒥))}
      using ιS_is Infer_ℳ_𝒞_is_Inf
      by auto
    then show ιS  { base_inf  𝒞 |  𝒞. base_pre  𝒞 
                       ( 𝒥. { base_inf  𝒞 } ιprojJ 𝒥  FRedI (N projJ 𝒥)) } 
                    { unsat_inf  | . unsat_pre   to_AF bot  N }
      by fast
  next
    case (unsat 𝒩)
    then have ιS  { unsat_inf  | . unsat_pre   to_AF bot  N}
      using concl_ιS_in_N
      by fastforce
    then show ιS  { base_inf  𝒞 |  𝒞. base_pre  𝒞 
                        ( 𝒥. { base_inf  𝒞 } ιprojJ 𝒥  FRedI (N projJ 𝒥)) } 
                    { unsat_inf  | . unsat_pre   to_AF bot  N }
      by fast
  qed
qed

end (* locale annotated_calculus *)


subsection ‹Standard completeness›

context annotated_calculus
begin

(* This is a bundle containing some rules which are mostly used together.
 * Its purpose is simply to reduce the visual clutter from long proofs. *)
lemmas SRed_rules = SRedF_entails_bot SRedF_of_subset_F SRedI_of_subset_F SRedF_of_SRedF_subset_F
                    SRedI_of_SRedF_subset_F SRedI_of_SInf_to_N_F SRedI_in_SInf

(* Report lemma 18 *)
sublocale S_calculus: calculus to_AF bot SInf AF_entails SRedI SRedF
  by (standard; simp add: SRed_rules)

(* Report lemma 20 *)
lemma S_saturated_to_F_saturated: S_calculus.saturated 𝒩  saturated (𝒩 projJ 𝒥)
proof -
  assume 𝒩_is_S_saturated: S_calculus.saturated 𝒩
  then show saturated (𝒩 projJ 𝒥)
    unfolding saturated_def S_calculus.saturated_def
  proof (intro subsetI)
    fix ιF
    assume ιF  Inf_from (𝒩 projJ 𝒥)
    then have ιF_is_Inf: ιF  FInf and
              prems_of_ιF_in_𝒩_proj_𝒥: set (prems_of ιF)  𝒩 projJ 𝒥
      unfolding Inf_from_def
      by auto
    moreover have  C  set (prems_of ιF).  𝒞  𝒩. F_of 𝒞 = C  enabled 𝒞 𝒥
      using prems_of_ιF_in_𝒩_proj_𝒥
      unfolding enabled_projection_def
      by blast
    then have list_all (λ C.  𝒞  𝒩. F_of 𝒞 = C  enabled 𝒞 𝒥) (prems_of ιF)
      using Ball_set
      by blast
    then have  𝒞s. length 𝒞s = length (prems_of ιF) 
                     list_all2 (λ C 𝒞. 𝒞  𝒩  F_of 𝒞 = C  enabled 𝒞 𝒥) (prems_of ιF) 𝒞s
      using list_all_ex_to_ex_list_all2
      by (smt (verit, best) Ball_set)
    then have  As. length As = length (prems_of ιF) 
                     list_all2 (λ C A. AF.Pair C A  𝒩  enabled (AF.Pair C A) 𝒥) (prems_of ιF) As
      by (smt (verit, del_insts) AF.exhaust AF.sel(1) list.pred_mono_strong
          list_all_ex_to_ex_list_all2)
    then have  As. length As = length (prems_of ιF) 
                     list_all (λ 𝒞. 𝒞  𝒩  enabled 𝒞 𝒥) (map2 AF.Pair (prems_of ιF) As)
      using list_all2_to_map[where f = λ C A. AF.Pair C A]
      by (smt (verit) list_all2_mono)
    then obtain As :: 'v sign fset list
                   where  𝒞  set (map2 AF.Pair (prems_of ιF) As). 𝒞  𝒩  enabled 𝒞 𝒥 and
                         length_As_eq_length_prems: length As = length (prems_of ιF)
      by (metis (no_types, lifting) Ball_set_list_all)
    then have set_prems_As_subset_𝒩: set (map2 AF.Pair (prems_of ιF) As)  𝒩 and
              all_enabled:  𝒞  set (map2 AF.Pair (prems_of ιF) As). enabled 𝒞 𝒥
      by auto

    let ?prems = map2 AF.Pair (prems_of ιF) As

    have set ?prems  𝒩
      using set_prems_As_subset_𝒩 .
    moreover have length ?prems = length (prems_of ιF)
      using length_As_eq_length_prems
      by simp
    then have F_of_dummy_prems_is_prems_of_ιF: map F_of ?prems = prems_of ιF
      by (simp add: length_As_eq_length_prems)
    moreover have  𝒞  set (map A_of (map2 AF.Pair (prems_of ιF) As)). fset 𝒞  total_strip 𝒥
      using
        all_enabled ball_set_f_to_ball_set_map[where P = λ x. fset x  total_strip 𝒥 and f = A_of]
      unfolding enabled_def
      by blast
    then have  𝒞  set As. fset 𝒞  total_strip 𝒥
      using map_A_of_map2_Pair length_As_eq_length_prems
      by metis
    then have fset (ffUnion (fset_of_list As))  total_strip 𝒥
      using all_enabled
      unfolding enabled_def[of _ 𝒥]
      by (simp add: fBall_fset_of_list_iff_Ball_set fset_ffUnion_subset_iff_all_fsets_subset)
    then have base_inf_enabled: enabled_inf (base_inf ?prems (concl_of ιF)) 𝒥
      using all_enabled enabled_inf_def
      by auto
    moreover have pre_holds: base_pre ?prems (concl_of ιF)
      using ιF_is_Inf F_of_dummy_prems_is_prems_of_ιF
      by force
    moreover have ιF_of_base_inf_is_ιF: ιF_of (base_inf ?prems (concl_of ιF)) = ιF
      using F_of_dummy_prems_is_prems_of_ιF ιF_of_def
      by force
    ultimately have ιF_in_Inf_𝒩_proj_𝒥: ιF  (S_calculus.Inf_from 𝒩) ιprojJ 𝒥
      using SInf.base[OF pre_holds]
      unfolding enabled_projection_Inf_def S_calculus.Inf_from_def
      by (metis (mono_tags, lifting) inference.sel(1) mem_Collect_eq)
    then have   D. base_inf  D  S_calculus.Inf_from 𝒩 
                ιF_of (base_inf  D) = ιF  enabled_inf (base_inf  D) 𝒥
      using ιF_of_base_inf_is_ιF
      unfolding enabled_projection_Inf_def
      by (metis (mono_tags, lifting) CollectI S_calculus.Inf_from_def SInf.base
          base_inf_enabled inference.sel(1) pre_holds set_prems_As_subset_𝒩)
    then obtain  D where base_inf_in_Inf_𝒩: base_inf  D  S_calculus.Inf_from 𝒩 and
                           ιF_of_base_inf_is_ιF: ιF_of (base_inf  D) = ιF and
                           base_inf_enabled: enabled_inf (base_inf  D) 𝒥
      by blast
    then have base_inf  D  SRedI 𝒩
      using 𝒩_is_S_saturated
      unfolding S_calculus.saturated_def
      by blast
    moreover have base_pre  D
      using ιF_of_base_inf_is_ιF ιF_is_Inf
      by (simp add: ιF_of_def)
    ultimately show ιF  FRedI (𝒩 projJ 𝒥)
      using ιF_in_Inf_𝒩_proj_𝒥 ιF_of_base_inf_is_ιF base_inf_enabled
      unfolding SRedI_def enabled_projection_Inf_def ιF_of_def enabled_def enabled_projection_def
      by auto
         (metis (mono_tags, lifting) AF.sel(2) F_of_to_AF Red_I_of_Inf_to_N bot_fset.rep_eq
          empty_subsetI inference.sel(2) mem_Collect_eq to_AF_def)
  qed
qed

(* This is easier to type than ‹AF_cons_rel.entails_conjunctive›, and looks more beautiful. *)
notation AF_cons_rel.entails_conjunctive (infix ⊨∩AF 50)

(* Report theorem 21 *)
theorem S_calculus_statically_complete:
  assumes F_statically_complete: statically_complete_calculus bot FInf (⊨) FRedI FRedF
  shows statically_complete_calculus (to_AF bot) SInf (⊨AF) SRedI SRedF
  using F_statically_complete
  unfolding statically_complete_calculus_def statically_complete_calculus_axioms_def
proof (intro conjI allI impI; elim conjE)
  show calculus (to_AF bot) SInf (⊨AF) SRedI SRedF
    using S_calculus.calculus_axioms
    by force
next
  fix N
  assume calculus bot FInf (⊨) FRedI FRedF and
         if_F_saturated_and_N_entails_bot_then_bot_in_N:
            N. saturated N  N  {bot}  bot  N and
         N_is_S_saturated: S_calculus.saturated N and
         N_entails_bot: N AF {to_AF bot}
  then have N_proj_𝒥_entails_bot:  𝒥. N projJ 𝒥  {bot}
    unfolding AF_entails_def
    using F_of_to_AF[of bot]
    by (smt (verit) enabled_to_AF_set image_empty image_insert)
  then have N_proj_𝒥_F_saturated:  𝒥. saturated (N projJ 𝒥)
    using N_is_S_saturated
    using S_saturated_to_F_saturated
    by blast
  then have  𝒥. bot  N projJ 𝒥
    using N_proj_𝒥_entails_bot if_F_saturated_and_N_entails_bot_then_bot_in_N
    by presburger
  then have prop_proj_N_is_prop_unsat: propositionally_unsatisfiable (proj N)
    unfolding enabled_projection_def propositional_model_def propositional_projection_def
      propositionally_unsatisfiable_def
    by fast
  then have proj N  {}
    unfolding propositionally_unsatisfiable_def propositional_model_def
    using enabled_projection_def prop_proj_in
    by auto
  then have  . set   proj N  finite (set )  propositionally_unsatisfiable (set )
    by (metis finite_list prop_proj_N_is_prop_unsat prop_unsat_compactness)
  then obtain  where ℳ_subset_prop_proj_N: set   proj N and
                       ℳ_subset_N: set   N and
                       finite (set ) and
                       ℳ_prop_unsat: propositionally_unsatisfiable (set ) and
                       ℳ_not_empty:   []
    by (smt (verit, del_insts) AF_cons_rel.entails_bot_to_entails_empty
        AF_cons_rel.entails_empty_reflexive_dangerous compactness_AF_proj equiv_prop_entails
        finite_list image_empty prop_proj_N_is_prop_unsat prop_proj_in propositional_model2_def
        propositionally_unsatisfiable_def set_empty2 subset_empty subset_trans to_AF_proj_J)
  then have unsat_inf   S_calculus.Inf_from N and
            Infer_ℳ_bot_in_SInf: unsat_inf   SInf
    using SInf.unsat S_calculus.Inf_from_def propositional_projection_def
    by fastforce+ 
  then have unsat_inf   SRedI N
    using N_is_S_saturated S_calculus.saturated_def
    by blast
  then show to_AF bot  N
    unfolding SRedI_def
  proof (elim UnE)
    assume unsat_inf   { base_inf  𝒞 |  𝒞. base_pre  𝒞 
      ( 𝒥. { base_inf  𝒞 } ιprojJ 𝒥  FRedI (N projJ 𝒥)) }
    then have unsat_inf  = base_inf  bot
      by (smt (verit, best) AF.exhaust_sel AF.sel(2) F_of_to_AF inference.inject mem_Collect_eq)
    then have to_AF bot = AF.Pair bot (ffUnion (A_of |`| fset_of_list ))
      by simp
    then have ffUnion (A_of |`| fset_of_list ) = {||}
      by (metis AF.sel(2) A_of_to_AF)
    then consider (ℳ_empty) A_of |`| fset_of_list  = {||} |
                  (no_assertions_in_ℳ) fBall (A_of |`| fset_of_list ) (λ x. x = {||})
      using Union_empty_if_set_empty_or_all_empty
      by auto
    then show ?thesis
    proof (cases)
      case ℳ_empty
      then have fset_of_list  = {||}
        by blast
      then have  = []
        by (metis bot_fset.rep_eq fset_of_list.rep_eq set_empty2)
      then show ?thesis
        using ℳ_not_empty
        by contradiction
    next
      case no_assertions_in_ℳ
      then have fBall (fset_of_list ) (λ x. A_of x = {||})
        using fBall_fimage_is_fBall
        by simp
      then have  x  set . A_of x = {||}
        using fBall_fset_of_list_iff_Ball_set
        by fast
      then have to_AF bot  set 
        using ℳ_subset_prop_proj_N ℳ_not_empty
        unfolding propositional_projection_def to_AF_def
        by (metis (mono_tags, lifting) AF.exhaust_sel CollectD ex_in_conv set_empty subset_code(1))
      then show ?thesis
        using ℳ_subset_N
        by blast
    qed
  next
    assume unsat_inf   { unsat_inf  | . unsat_pre   to_AF bot  N }
    then show ?thesis
      by fastforce
  qed
qed


(*<*)
lemma entails_conj_is_entails_disj_if_right_singleton:  ⊨∩AF {𝒞}   AF {𝒞}
  unfolding AF_cons_rel.entails_conjunctive_def
  by blast

lemma S_with_conj_is_calculus: Calculus.calculus {to_AF bot} SInf (⊨∩AF) SRedI SRedF
proof (standard) (* ; (simp only: SRed_rules)?) *)
  fix N
  show SRedI N  SInf
    by (simp only: SRed_rules)
next
  fix N B
  show B  {to_AF bot}  N ⊨∩AF {B}  N - SRedF N ⊨∩AF {B}
    by (simp add: AF_cons_rel.entails_conjunctive_def SRedF_entails_bot)
next
  fix N N'
  show N  N'  SRedF N  SRedF N'
    by (simp only: SRed_rules)
next
  fix N N'
  show N  N'  SRedI N  SRedI N'
    by (simp only: SRed_rules)
next
  fix N N'
  show N'  SRedF N  SRedF N  SRedF (N - N')
    by (simp only: SRed_rules)
next
  fix N N'
  show N'  SRedF N  SRedI N  SRedI (N - N')
    by (simp only: SRed_rules)
next
  fix ι N
  show ι  SInf  concl_of ι  N  ι  SRedI N
    by (simp only: SRed_rules)
qed

lemma saturated_equiv: S_calculus.saturated N  Calculus.calculus.saturated SInf SRedI N
  by (meson Calculus.calculus.saturated_def S_calculus.saturated_def S_with_conj_is_calculus)

lemma derivation_equiv:
  is_derivation S_calculus.derive Ns  chain (Calculus.calculus.derive SRedF) (to_llist Ns)
proof -
  have S_calculus.derive M N  Calculus.calculus.derive SRedF M N for M N
    unfolding S_calculus.derive_def
  proof (intro iffI)
    show M - N  SRedF N  Calculus.calculus.derive SRedF M N
      using S_with_conj_is_calculus calculus.derive.intros
      by blast
  next
    assume Calculus.calculus.derive SRedF M N
    then have M - N  SRedF N
      by (meson S_with_conj_is_calculus calculus.derive.cases)
    then show M - N  SRedF N .
  qed
  moreover have ( i. R (llnth M i) (llnth M (Suc i)))  chain R (to_llist M) for R M
  proof (intro iffI)
    assume all_of_M_in_rel:  i. R (llnth M i) (llnth M (Suc i))
    then show chain R (to_llist M)
    proof -
      have ¬ lnull (to_llist M)
        by (metis enat.simps(3) llength_eq_0 llength_of_to_llist_is_infinite zero_enat_def)
      moreover have  j. enat (j + 1) <   R (llnth M j) (llnth M (Suc j))
        using all_of_M_in_rel
        by blast
      then have  j. enat (j + 1) <   R (lnth (to_llist M) j) (lnth (to_llist M) (Suc j))
        by (simp add: llnth.rep_eq)
      ultimately show chain R (to_llist M)
        by (metis Suc_eq_plus1 all_of_M_in_rel llnth.rep_eq lnth_rel_chain)
    qed
  next
    assume chain_R_M: chain R (to_llist M)
    then show  i. R (llnth M i) (llnth M (Suc i))
    proof (intro allI)
      fix i
      have enat i < 
        using enat_ord_code(4)
        by presburger
      then have R (lnth (to_llist M) i) (lnth (to_llist M) (Suc i))
        by (simp add: chain_R_M chain_lnth_rel llength_of_to_llist_is_infinite)
      then show R (llnth M i) (llnth M (Suc i))
        by (simp add: llnth.rep_eq)
    qed
  qed
  ultimately have
    ( i. S_calculus.derive (llnth Ns i) (llnth Ns (Suc i))) 
     chain (Calculus.calculus.derive SRedF) (to_llist Ns)
    by metis
  then show ?thesis
    by (simp add: is_derivation_def)
qed

lemma fair_equiv: S_calculus.fair Ns  Calculus.calculus.fair SInf SRedI (to_llist Ns)
proof -
  have S_calculus.Inf_from (Liminf_llist (to_llist Ns))  Sup_llist (lmap SRedI (to_llist Ns)) 
        S_calculus.Inf_from (Liminf_infinite_llist Ns)  Sup_infinite_llist (llmap SRedI Ns)
    by transfer meson
  then show ?thesis
    using S_calculus.weakly_fair_def S_with_conj_is_calculus calculus.fair_def
    by blast
qed
(*>*)



text ‹
  The following proof works as follows.

  We assume that (Inf, (RedI, RedF))› is statically complete.
  From that and theorem @{thm S_calculus_statically_complete}, we obtain that
    (SInf, (SRedI, SRedF))› is statically complete.
  This means that for all 𝒩 ⊆ UNIV›, if 𝒩› is saturated w.r.t. (SInf, SRedI)›
    and 𝒩 ⊨∪AF {⊥}› then ⊥ ∈ 𝒩›.
  Since ⊨∪AF ≡ ⊨∩AF when the right hand side is a singleton set, we have that
    for all 𝒩 ⊆ UNIV›, if 𝒩› is saturated w.r.t. (SInf, SRedI)› and 𝒩 ⊨∩AF {⊥}› then ⊥ ∈ 𝒩›.

  Because ⊨∩AF is a consequence relation for the Saturation Framework, we can derive
      that (SInf, (SRedI, SRedF))› is dynamically complete (using the conjunctive entailment).
  We then proceed as above but in the opposite way to show that (SInf, (SRedI, SRedF))›
      is dynamically complete using the disjunctive entailment ⊨∪AF.
›

(* Report corollary 22 *)
corollary S_calculus_dynamically_complete:
  assumes F_statically_complete: statically_complete_calculus bot FInf (⊨) FRedI FRedF
  shows dynamically_complete_calculus (to_AF bot) SInf (⊨AF) SRedI SRedF
proof -
  have statically_complete_calculus (to_AF bot) SInf (⊨AF) SRedI SRedF
    using S_calculus_statically_complete F_statically_complete
    by blast
  then have statically_complete_calculus_axioms (to_AF bot) SInf (⊨∩AF) SRedI
    using entails_conj_is_entails_disj_if_right_singleton[where ?𝒞 = to_AF bot]
    unfolding statically_complete_calculus_def statically_complete_calculus_axioms_def
    by blast
  then have Calculus.statically_complete_calculus_axioms {to_AF bot} SInf (⊨∩AF) SRedI
    unfolding statically_complete_calculus_axioms_def
      Calculus.statically_complete_calculus_axioms_def
    using saturated_equiv
    by blast
  then have Calculus.statically_complete_calculus {to_AF bot} SInf (⊨∩AF) SRedI SRedF
    using Calculus.statically_complete_calculus.intro S_with_conj_is_calculus
    by blast
  then have Calculus.dynamically_complete_calculus {to_AF bot} SInf (⊨∩AF) SRedI SRedF
    using S_with_conj_is_calculus calculus.dyn_equiv_stat
    by blast
  then have Calculus.dynamically_complete_calculus_axioms {to_AF bot} SInf (⊨∩AF) SRedI SRedF
    using Calculus.dynamically_complete_calculus_def
    by blast
  then have dynamically_complete_calculus_axioms (to_AF bot) SInf (⊨∩AF) SRedI SRedF
    unfolding dynamically_complete_calculus_axioms_def
      Calculus.dynamically_complete_calculus_axioms_def
    by (metis derivation_equiv fair_equiv llhd.rep_eq llnth.rep_eq singletonD singletonI)
  then have dynamically_complete_calculus_axioms (to_AF bot) SInf (⊨AF) SRedI SRedF
    unfolding dynamically_complete_calculus_axioms_def
    using entails_conj_is_entails_disj_if_right_singleton
    by presburger
  then show dynamically_complete_calculus (to_AF bot) SInf (⊨AF) SRedI SRedF
    by (simp add: dynamically_complete_calculus_def
        S_calculus.calculus_axioms)
qed





subsection ‹Strong completeness›

(* Report theorem 24 *)
theorem S_calculus_strong_statically_complete:
  assumes F_statically_complete: statically_complete_calculus bot FInf (⊨) FRedI FRedF and
          𝒩_locally_saturated: locally_saturated 𝒩 and
          𝒩_entails_bot: 𝒩 AF {to_AF bot}
  shows to_AF bot  𝒩
  using 𝒩_locally_saturated
  unfolding locally_saturated_def
proof (elim disjE)
  show to_AF bot  𝒩  to_AF bot  𝒩
    by blast
next
  assume  J. J p 𝒩  saturated (𝒩 projJ J)
  then obtain J where J_prop_model_of_𝒩: J p 𝒩 and
                      𝒩_proj_J_saturated: saturated (𝒩 projJ J)
    by blast
  then have 𝒩 projJ J  {bot}
    using 𝒩_entails_bot AF_entails_def enabled_to_AF_set
    by (metis (no_types, lifting) f_of_to_AF image_insert image_is_empty) 
  then have bot  𝒩 projJ J
    using 𝒩_proj_J_saturated F_statically_complete
    by (simp add: statically_complete_calculus.statically_complete)
  then show to_AF bot  𝒩
    using J_prop_model_of_𝒩
    using enabled_projection_def propositional_model_def propositional_projection_def
    by force
qed

(*<*)
lemma SRed_of_lim_inf:
  SRedF (lim_inf 𝒩i) projJ J  FRedF (lim_inf 𝒩i projJ J)  (lim_inf 𝒩i projJ J)
proof (intro subsetI)
  fix f
  assume f  SRedF (lim_inf 𝒩i) projJ J
  then show f  FRedF (lim_inf 𝒩i projJ J)  (lim_inf 𝒩i projJ J)
    unfolding SRedF_def enabled_projection_def enabled_def
    using less_eq_fset.rep_eq
    by (auto, fastforce)
qed

lemma bot_at_i_implies_bot_at_liminf:
  is_derivation S_calculus.derive 𝒩i  to_AF bot  llnth 𝒩i i  to_AF bot  lim_inf 𝒩i
proof -
  assume 𝒩i_is_derivation: is_derivation S_calculus.derive 𝒩i and
         bot_at_i: to_AF bot  llnth 𝒩i i
  then have  i. llnth 𝒩i i - llnth 𝒩i (Suc i)  SRedF (llnth 𝒩i (Suc i))
    unfolding is_derivation_def S_calculus.derive_def
    by blast
  then show ?thesis
    using bot_at_i
  proof (transfer fixing: bot i FRedF)
    fix 𝒩i'
    assume llength_is_infinity: llength 𝒩i' =  and
           bot_at_i: to_AF bot  lnth 𝒩i' i and
           all_at_i_minus_next_i_are_redundant:
              i. lnth 𝒩i' i - lnth 𝒩i' (Suc i)  SRedF (lnth 𝒩i' (Suc i))
    then have to_AF bot  lnth 𝒩i' (Suc i)
      using bot_not_in_sredF_𝒩
      by auto
    then have  j  i. to_AF bot  lnth 𝒩i' j
    proof (intro allI impI)
      fix j
      assume i  j
      then show to_AF bot  lnth 𝒩i' j
      proof (induct j rule: full_nat_induct)
        case less: (1 n)
        show ?case
        proof (cases i = n)
          case True
          then show ?thesis
            using bot_at_i
            by force
        next
          case False
          then have i_less_than_n: i < n
            using le_eq_less_or_eq less.prems
            by presburger
          then have n_positive: n > 0
            by force
          then have to_AF bot  lnth 𝒩i' (n - 1)
            using i_less_than_n less.hyps
            by fastforce
          then show ?thesis
            using all_at_i_minus_next_i_are_redundant[rule_format, of n - 1]
                  bot_not_in_sredF_𝒩 n_positive
            by auto
        qed
      qed
    qed
    then have  i.  j  i. to_AF bot  lnth 𝒩i' j
      by blast
    then show to_AF bot  Liminf_llist 𝒩i'
      using llength_is_infinity
      unfolding Liminf_llist_def
      by auto
  qed
qed

lemma Red_I_of_inf_FRedF_subset_Red_I_of_inf:
  FRedI ((lim_inf 𝒩i projJ J)  FRedF (lim_inf 𝒩i projJ J)) = FRedI (lim_inf 𝒩i projJ J)
proof (intro subset_antisym)
  have FRedF (lim_inf 𝒩i projJ J)  FRedF ((lim_inf 𝒩i projJ J)  FRedF (lim_inf 𝒩i projJ J))
    by (simp add: Red_F_of_subset)
  then show FRedI ((lim_inf 𝒩i projJ J)  FRedF (lim_inf 𝒩i projJ J))  FRedI (lim_inf 𝒩i projJ J)
    by (smt (verit, del_insts) DiffE Red_I_of_Red_F_subset Red_I_of_subset Un_iff subset_iff) 
next
  show FRedI (lim_inf 𝒩i projJ J)  FRedI ((lim_inf 𝒩i projJ J)  FRedF (lim_inf 𝒩i projJ J))
    by (simp add: Red_I_of_subset)
qed
(*>*)



(* Report lemma 27 *)
lemma locally_fair_derivation_is_saturated_at_liminf:
  is_derivation S_calculus.derive 𝒩i  locally_fair 𝒩i  locally_saturated (lim_inf 𝒩i)
proof -
  assume 𝒩i_is_derivation: is_derivation S_calculus.derive 𝒩i and
         locally_fair 𝒩i
  then show locally_saturated (lim_inf 𝒩i)
    unfolding locally_fair_def
  proof (elim disjE)
    assume  i. to_AF bot  llnth 𝒩i i
    then obtain i where to_AF bot  llnth 𝒩i i
      by blast
    then have to_AF bot  lim_inf 𝒩i
      using bot_at_i_implies_bot_at_liminf[OF 𝒩i_is_derivation]
      by blast
    then show ?thesis
      unfolding locally_saturated_def
      by blast
  next
    assume  J. J p limit 𝒩i  Inf_from (limit 𝒩i projJ J)  ( i. FRedI (llnth 𝒩i i projJ J))
    then obtain J where J_prop_model_of_limit: J p limit 𝒩i and
                        all_inf_of_limit_are_redundant:
                          Inf_from (limit 𝒩i projJ J)  ( i. FRedI (llnth 𝒩i i projJ J))
      by blast
    then have  i. llnth 𝒩i i  lim_inf 𝒩i  SRedF (lim_inf 𝒩i)
      using Calculus.calculus.i_in_Liminf_or_Red_F[OF S_with_conj_is_calculus, of to_llist 𝒩i]
            derivation_equiv[of 𝒩i]
      by (simp add: Liminf_infinite_llist.rep_eq 𝒩i_is_derivation llength_of_to_llist_is_infinite
          llnth.rep_eq sup_commute)
    then have  i. llnth 𝒩i i projJ J  (lim_inf 𝒩i projJ J)  FRedF (lim_inf 𝒩i projJ J)
      by (smt (verit, best) SRed_of_lim_inf UN_iff UnE UnI1 Un_commute
          Union_of_enabled_projection_is_enabled_projection subset_iff)
    then have FRedI_in_Red_I_of_FRedF:
      ( i. FRedI (llnth 𝒩i i projJ J)) 
        ( i. FRedI ((lim_inf 𝒩i projJ J)  FRedF (lim_inf 𝒩i projJ J)))
      by (meson Red_I_of_subset SUP_mono UNIV_I)
    then have ( i. FRedI (llnth 𝒩i i projJ J))  ( i. FRedI (lim_inf 𝒩i projJ J))
      using Red_I_of_inf_FRedF_subset_Red_I_of_inf
      by auto
    then show ?thesis
      unfolding locally_saturated_def
      using J_prop_model_of_limit all_inf_of_limit_are_redundant saturated_def
      by force
  qed
qed

(*<*)
lemma llhd_is_llnth_0: llhd S = llnth S 0
  by (transfer, metis infinity_ne_i0 llength_lnull lnth_0_conv_lhd)
(*>*)



(* Report theorem 28 (proof 1) *)
theorem S_calculus_strong_dynamically_complete:
  assumes F_statically_complete: statically_complete_calculus bot FInf (⊨) FRedI FRedF and
          𝒩i_is_derivation: is_derivation S_calculus.derive 𝒩i and
          𝒩i_is_locally_fair: locally_fair 𝒩i and
          𝒩i0_entails_bot: llhd 𝒩i AF {to_AF bot}
  shows  i. to_AF bot  llnth 𝒩i i
proof -
  have llhd 𝒩i  ( i. llnth 𝒩i i)
    by (simp add: SUP_upper llhd_is_llnth_0)
  then have ( i. llnth 𝒩i i) AF {to_AF bot}
    using 𝒩i0_entails_bot
    by (meson AF_cons_rel.entails_trans AF_cons_rel.subset_entailed
        entails_conj_is_entails_disj_if_right_singleton)
  then have ( i. llnth 𝒩i i) - SRedF ( i. llnth 𝒩i i) AF {to_AF bot}
    using SRedF_entails_bot
    by blast
  moreover have chain (Calculus.calculus.derive SRedF) (to_llist 𝒩i)
    using derivation_equiv[of 𝒩i] 𝒩i_is_derivation
    by blast
  then have Sup_llist (to_llist 𝒩i) - Liminf_llist (to_llist 𝒩i)  SRedF (Sup_llist (to_llist 𝒩i))
    using Calculus.calculus.Red_in_Sup[OF S_with_conj_is_calculus]
    by blast
  then have ( i. llnth 𝒩i i) - SRedF ( i. llnth 𝒩i i)  lim_inf 𝒩i
    by (transfer fixing: FRedF, unfold Sup_llist_def Liminf_llist_def, auto)
  ultimately have 𝒩i_inf_entails_bot: lim_inf 𝒩i AF {to_AF bot}
    by (meson AF_cons_rel.entails_subsets subset_iff)
  then have 𝒩i_inf_locally_saturated: locally_saturated (lim_inf 𝒩i)
    using 𝒩i_is_derivation 𝒩i_is_locally_fair
    using locally_fair_derivation_is_saturated_at_liminf
    by blast
  then have to_AF bot  lim_inf 𝒩i
    using F_statically_complete S_calculus_strong_statically_complete 𝒩i_inf_entails_bot
    by blast
  then show  i. to_AF bot  llnth 𝒩i i
    by (transfer fixing: bot)
       (meson Liminf_llist_imp_exists_index)
qed

end (* context annotated_calculus *)

section ‹Extensions: Inferences and simplifications›

subsection ‹Simplifications›

datatype 'f simplification =
  Simplify (S_from: 'f set) (S_to: 'f set)

text ‹
  Simplification rules are said to be sound if every conclusion is entailed by all premises.
  We could have also used our conjunctive entailment
  @{const consequence_relation.entails_conjunctive}, but it is defined that way so there is
  nothing to worry about.
›

locale AF_calculus = sc: sound_calculus bot Inf entails entails_sound RedI RedF
  for
    bot :: "('f, 'v :: countable) AF" and
    Inf :: ('f, 'v) AF inference set and
    entails :: "('f, 'v) AF set  ('f, 'v) AF set  bool" and
    entails_sound :: "('f, 'v) AF set  ('f, 'v) AF set  bool" and
    RedI :: "('f, 'v) AF set  ('f, 'v) AF inference set" and
    RedF :: "('f, 'v) AF set  ('f, 'v) AF set"

locale AF_calculus_extended = 
  AF_calculus bot Inf entails entails_sound RedI RedF
  for bot :: ('f, 'v :: countable) AF and
      Inf :: ('f, 'v) AF inference set and
      entails :: ('f, 'v) AF set  ('f, 'v) AF set  bool and
      entails_sound :: ('f, 'v) AF set  ('f, 'v) AF set  bool (infix ⊨s 50) and
      RedI :: ('f, 'v) AF set  ('f, 'v) AF inference set and
      RedF :: ('f, 'v) AF set  ('f, 'v) AF set
  + fixes
      Simps :: ('f, 'v) AF simplification set and
      OptInfs :: ('f, 'v) AF inference set
    assumes
      simps_simp: δ  Simps  (S_from δ - S_to δ)  RedF (S_to δ) and
      simps_sound: δ  Simps  𝒞  S_to δ. S_from δ ⊨s {𝒞} and
      (* no_infinite_simps: ‹finite (S_from δ) ⟹ δ ∈ Simps ⟹ finite (S_to δ)› and *)
      infs_sound: ι  OptInfs  set (prems_of ι) ⊨s {concl_of ι}
begin

lemma simp_in_derivations: δ  Simps  
  sc.derive (  S_from δ) (  S_to δ)
  unfolding sc.derive_def
proof 
  fix C
  assume d_in: δ  Simps and
    C    S_from δ - (  S_to δ)
  then have C  S_from δ - S_to δ
    by blast
  then show C  RedF (  S_to δ)
    using simps_simp[OF d_in] by (meson sc.Red_F_of_subset subset_eq sup.cobounded2)
qed

lemma opt_infs_in_derivations: ι  OptInfs  
  sc.derive (  set (prems_of ι)) (  set (prems_of ι)  {concl_of ι})
  unfolding sc.derive_def
proof 
  fix C
  assume ι  OptInfs and
    C_in: C    set (prems_of ι) - (  set (prems_of ι)  {concl_of ι})
  have   set (prems_of ι) - (  set (prems_of ι)  {concl_of ι}) = {}
    by blast
  then have False using C_in by auto
  then show C  RedF (  set (prems_of ι)  {concl_of ι})
    by auto
qed

end

text ‹Empty sets of simplifications and optional inferences are accepted in 
  termlocale AF_calculus_extended›

context AF_calculus
begin

sublocale empty_simps: 
  AF_calculus_extended bot Inf entails entails_sound RedI RedF 
  "{} :: ('f, 'v) AF simplification set" "{} :: ('f, 'v) AF inference set" 
  by (unfold_locales, auto)

end (* context AF_calculus *)


text ‹
  Here we extend our basic calculus with simplification rules, one at a time:
   \textsc{Split} performs a $n$-ary case analysis on the head of the premise;
   \textsc{Collect} performs garbage collection on clauses which contain propositionally
  unsatisfiable heads;
   \textsc{Trim} removes assertions which are entailed by others.
›

subsubsection ‹The Split Rule›

locale AF_calculus_with_split =
  base_calculus: AF_calculus_extended bot SInf entails entails_sound SRedI
  SRedF Simps OptInfs
  for bot :: ('f, 'v :: countable) AF and
      SInf :: ('f, 'v) AF inference set and
      entails :: ('f, 'v) AF set  ('f, 'v) AF set  bool (infix AF 50) and
      entails_sound :: ('f, 'v) AF set  ('f, 'v) AF set  bool (infix AFs 50) and
      SRedI :: ('f, 'v) AF set  ('f, 'v) AF inference set and
      SRedF :: ('f, 'v) AF set  ('f, 'v) AF set and
      Simps :: ('f, 'v) AF simplification set and
      OptInfs :: ('f, 'v) AF inference set
  + fixes
      splittable :: ('f, 'v) AF  ('f, 'v) AF fset  bool
    assumes
(*      split_creates_singleton_assertion_sets: 
        ‹splittable 𝒞 𝒞s ⟹ 𝒟 |∈| 𝒞s ⟹ (∃ (a :: 'v sign). A_of 𝒟 = {| a |})›  and
      split_not_empty: ‹splittable 𝒞 𝒞s ⟹ 𝒞s ≠  {||}› and *)
      split_sound1: splittable 𝒞 𝒞s 
        {𝒞} AFs {AF.Pair (F_of bot) (ffUnion (fimage neg |`| A_of |`| 𝒞s) |∪| A_of 𝒞)} and
      split_sound2: splittable 𝒞 𝒞s   𝒞'  fset 𝒞s. {𝒞} AFs {𝒞'} and
      split_simp: splittable 𝒞 𝒞s  𝒞  SRedF 
        ({AF.Pair (F_of bot) (ffUnion ((|`|) neg |`| A_of |`| 𝒞s) |∪| A_of 𝒞)}  fset 𝒞s)
begin

text ‹
  Rule definitions follow a similar naming convention to our two inference rules
  \textsc{Base} and \textsc{Unsat} defined in @{locale annotated_calculus}:
  $X\_simp$ is the definition of the simplification rule, while $X\_pre$ is some
  precondition which must hold for the rule to be applicable.
› 

abbreviation split_pre :: ('f, 'v) AF  ('f, 'v) AF fset  bool where
  split_pre 𝒞 𝒞s  splittable 𝒞 𝒞s

abbreviation split_res :: ('f, 'v) AF  ('f, 'v) AF fset  ('f, 'v) AF set where
  split_res 𝒞 𝒞s  
    (insert (AF.Pair (F_of bot) (ffUnion (fimage neg |`| A_of |`| 𝒞s) |∪| A_of 𝒞)) (fset 𝒞s))

abbreviation split_simp :: ('f, 'v) AF  ('f, 'v) AF fset  ('f, 'v) AF simplification where
  split_simp 𝒞 𝒞s  Simplify {𝒞} (split_res 𝒞 𝒞s)

(* Report definition 9 (Simps extended with Split) *)
inductive_set Simps_with_Split :: ('f, 'v) AF simplification set where
  split: split_pre 𝒞 𝒞s  split_simp 𝒞 𝒞s  Simps_with_Split
| other: simp  Simps  simp  Simps_with_Split

(*
lemma no_infinite_simps: ‹finite (S_from ι) ⟹ ι ∈ Simps_with_Split ⟹ finite (S_to ι)›
  using Simps_with_Split.cases base_calculus.no_infinite_simps
  by force 
*)

(* Report theorem 14 for Simps extended with Split *)
theorem Inf_with_split_sound_wrt_entails_sound:
  ι  Simps_with_Split   𝒞  S_to ι. S_from ι AFs {𝒞}
proof -
  assume ι_is_simp_rule: ι  Simps_with_Split
  then show  𝒞  S_to ι. S_from ι AFs {𝒞}
  proof (intro ballI)
    fix 𝒞
    assume 𝒞_is_consq_of_ι: 𝒞  S_to ι
    show S_from ι AFs {𝒞}
      using ι_is_simp_rule
    proof (cases rule: Simps_with_Split.cases)
      case (split 𝒞' 𝒞s)

      have S_from ι AFs {AF.Pair (F_of bot) (ffUnion (fimage neg |`| A_of |`| 𝒞s) |∪| A_of 𝒞')}
        using split_sound1 split by auto
      moreover have 𝒞'  fset 𝒞s. S_from ι AFs {𝒞'}
        using split_sound2 split by auto
      ultimately show ?thesis
        using 𝒞_is_consq_of_ι split(1) unfolding S_to_def by auto
    next
      case other
      then show ?thesis
        using 𝒞_is_consq_of_ι base_calculus.simps_sound by auto
    qed
  qed
qed

(* Report theorem 19 for Split *)
lemma split_redundant: split_pre 𝒞 𝒞s  𝒞  SRedF (split_res 𝒞 𝒞s)
proof -
  assume pre_cond: split_pre 𝒞 𝒞s
  then show 𝒞  SRedF (split_res 𝒞 𝒞s)
    using split_simp by simp
qed

(* Report theorem 19 for Simps extended with Split *)
lemma simps_with_split_are_simps: ι  Simps_with_Split  (S_from ι - S_to ι)  SRedF (S_to ι)
proof
  fix 𝒞
  assume i_in: ι  Simps_with_Split and
    C_in: 𝒞  S_from ι - S_to ι
  then show 𝒞  SRedF (S_to ι)
  proof (cases rule: Simps_with_Split.cases)
    case (split 𝒞' 𝒞s)
    then have 𝒞 = 𝒞' using C_in by auto
    moreover have S_to ι = split_res 𝒞' 𝒞s using split(1) simplification.sel(2) by auto
    ultimately show ?thesis
      using split_redundant[OF split(2)] by presburger
  next
    case other
    then show ?thesis
      using base_calculus.simps_simp C_in by blast
  qed
qed

sublocale AF_calc_ext: AF_calculus_extended bot SInf entails entails_sound 
  SRedI SRedF Simps_with_Split OptInfs
  using simps_with_split_are_simps Inf_with_split_sound_wrt_entails_sound (*no_infinite_simps*)
  base_calculus.infs_sound  by (unfold_locales, auto)

end (* locale AF_calculus_with_split *)

locale splitting_calculus =
  core: annotated_calculus bot Inf entails entails_sound RedI RedF fml asn 
  for bot :: 'f and
      Inf :: 'f inference set and
      entails :: 'f set  'f set  bool (infix  50) and
      entails_sound :: 'f set  'f set  bool (infix ⊨s 50) and
      RedI :: 'f set  'f inference set and
      RedF :: 'f set  'f set and
      fml :: 'v :: countable  'f and
      asn :: 'f sign  ('v :: countable) sign set
begin

interpretation AF_sound_cons_rel: consequence_relation to_AF bot (⊨sAF)
  by (rule core.AF_ext_sound_cons_rel)

interpretation SInf_sound_inf_system: sound_inference_system core.SInf to_AF bot (⊨sAF)
  by (standard, auto simp add: core.SInf_sound_wrt_entails_sound)

text ‹
  Rule definitions follow a similar naming convention to our two inference rules
  \textsc{Base} and \textsc{Unsat} defined in @{locale annotated_calculus}:
  $X\_simp$ is the definition of the simplification rule, while $X\_pre$ is some
  precondition which must hold for the rule to be applicable.
› 

definition split_form :: 'f  'f fset  bool where
  split_form C Cs  C  bot  fcard Cs  2
                     {C} ⊨s fset Cs  ( C'. C' |∈| Cs  C  RedF {C'})

definition mk_split :: 'f  'f fset  ('f, 'v) AF fset where
  split_form C Cs  mk_split C Cs  (λ C'. AF.Pair C' {| SOME a. a  asn (Pos C') |}) |`| Cs

definition splittable :: ('f, 'v) AF  ('f, 'v) AF fset  bool where
  splittable 𝒞 𝒞s  split_form (F_of 𝒞) (F_of |`| 𝒞s)  mk_split (F_of 𝒞) (F_of |`| 𝒞s) = 𝒞s

lemma split_creates_singleton_assertion_sets:
  splittable 𝒞 𝒞s  A |∈| 𝒞s  ( a. A_of A = {| a |})
  using mk_split_def unfolding splittable_def by (metis (no_types, lifting) AF.sel(2) fimageE)

lemma split_all_assertion_sets_asn:
  splittable 𝒞 𝒞s  A |∈| 𝒞s  ( a. A_of A = {|a|}  a  asn (Pos (F_of A)))
proof -
  assume pre_cond: splittable 𝒞 𝒞s and
         A_elem_As: A |∈| 𝒞s
  then have pre_cond1: split_form (F_of 𝒞) (F_of |`| 𝒞s) and
    pre_cond2: mk_split (F_of 𝒞) (F_of |`| 𝒞s) = 𝒞s
    unfolding splittable_def by auto
  have mk_split_applied_def: mk_split (F_of 𝒞) (F_of |`| 𝒞s)  
    (λ C'. AF.Pair C' {| SOME a. a  asn (Pos C') |}) |`| (F_of |`| 𝒞s)
    using mk_split_def pre_cond unfolding splittable_def by (smt (verit, del_insts))
  have  a. A_of A = {|a|}
    using pre_cond A_elem_As by (simp add: split_creates_singleton_assertion_sets)
  then obtain a where A_of_A_singleton_a: A_of A = {|a|}
    by blast
  then have a  asn (Pos (F_of A))
    using pre_cond2 A_elem_As core.asn_not_empty some_in_eq unfolding mk_split_applied_def
    by (smt (z3) AF.exhaust_sel AF.inject FSet.fsingletonE fimage.rep_eq finsertI1 imageE someI_ex)
  then show  a. A_of A = {|a|}  a  asn (Pos (F_of A))
    using A_of_A_singleton_a by blast
qed

lemma split_all_pairs_in_As_in_Cs: splittable 𝒞 𝒞s  ( P. P |∈| 𝒞s  F_of P |∈| (F_of |`| 𝒞s))
  using mk_split_def
  by fastforce

lemma split_all_pairs_in_Cs_in_As:
  splittable 𝒞 𝒞s  ( C. C |∈| (F_of |`| 𝒞s)  ( a. AF.Pair C {|a|} |∈| 𝒞s))
  using mk_split_def unfolding splittable_def
  by fastforce

lemma split_not_empty: splittable 𝒞 𝒞s  𝒞s   {||}
  unfolding splittable_def split_form_def
  by (metis bot_nat_0.extremum fcard_fempty fimage_fempty le_antisym nat.simps(3) numerals(2))

notation core.sound_cons.entails_neg (infix ⊨s 50)

lemma split_sound1: splittable 𝒞 𝒞s 
  {𝒞} ⊨sAF {AF.Pair bot (ffUnion (fimage neg |`| A_of |`| 𝒞s) |∪| A_of 𝒞)}
proof -
  assume split_cond: splittable 𝒞 𝒞s
  then have split_form: split_form (F_of 𝒞) (F_of |`| 𝒞s) and 
    split_mk: mk_split (F_of 𝒞) (F_of |`| 𝒞s) = 𝒞s
    unfolding splittable_def by auto
  define Cs where Cs = F_of |`| 𝒞s
  have Cs_not_empty: Cs  {||}
    using split_cond split_not_empty unfolding Cs_def by blast
  then have 𝒞s_not_empty: 𝒞s  {||}
    using mk_split_def[of F_of 𝒞 Cs] split_mk split_form
    fimage_of_non_fempty_is_non_fempty[OF Cs_not_empty] unfolding Cs_def by fastforce
  have fcard Cs  1
    by (simp add: Cs_not_empty Suc_le_eq non_zero_fcard_of_non_empty_set)
  then have card_fset_Cs_ge_1: card (Pos ` fset Cs)  1
    by (metis Cs_not_empty bot_fset.rep_eq card_eq_0_iff empty_is_image finite_fset finite_imageI
        fset_cong less_one linorder_not_le)
  have {F_of 𝒞} ⊨s fset Cs
    using split_form unfolding Cs_def split_form_def by blast
  then have F_of_𝒞_entails_Cs: {Pos (F_of 𝒞)} ⊨s Pos ` fset Cs
    unfolding core.sound_cons.entails_neg_def
    by (smt (verit, del_insts) UnCI imageI mem_Collect_eq singleton_conv
        core.sound_cons.entails_subsets subsetI)

  have finite_image_Pos_Cs: finite (Pos ` fset Cs)
    using finite_fset by blast

  have all_Ci_entail_bot: fset (ffUnion (fimage neg |`| A_of |`| 𝒞s) |∪| A_of 𝒞)  total_strip J
    AF.Pair Ci {|ai|} |∈| 𝒞s  (core.fml_ext ` total_strip J)  {Pos Ci} ⊨s {Pos bot}
    for J Ci ai
  proof -
    fix J 𝒞i ai
    assume fset (ffUnion (fimage neg |`| A_of |`| 𝒞s) |∪| A_of 𝒞)  total_strip J and
      Pair_𝒞i_ai_in_As: AF.Pair 𝒞i {|ai|} |∈| 𝒞s
    then have neg ai  total_strip J
      using mk_disjoint_finsert
      by fastforce
    then have neg_fml_ai_in_J: neg (core.fml_ext ai)  core.fml_ext ` total_strip J
      by (metis core.fml_ext.simps(1) core.fml_ext.simps(2) image_iff is_Neg_to_V is_Pos_to_V
          neg.simps(1) neg.simps(2))
    moreover have ai_in_asn_𝒞i: ai  asn (Pos 𝒞i)
      using split_all_assertion_sets_asn[OF split_cond Pair_𝒞i_ai_in_As]
      by auto
    moreover have {Pos 𝒞i} ⊨s {Pos 𝒞i}
      by (meson consequence_relation.entails_reflexive core.sound_cons.ext_cons_rel)
    then have (core.fml_ext ` (total_strip J - {neg ai})  {Pos 𝒞i}) ⊨s {Pos 𝒞i, Pos bot}
      by (smt (verit, best) Un_upper2 consequence_relation.entails_subsets insert_is_Un
          core.sound_cons.ext_cons_rel sup_ge1)
    ultimately show core.sound_cons.entails_neg ((core.fml_ext ` total_strip J)  {Pos 𝒞i}) {Pos bot}
    proof -
      have (core.fml_ext ` total_strip J  {core.fml_ext ai}) ⊨s ({Pos bot}  {})
        by (smt (z3) Bex_def_raw UnCI Un_commute Un_insert_right Un_upper2 neg_fml_ai_in_J
            consequence_relation.entails_subsets insert_is_Un insert_subset
            core.sound_cons.ext_cons_rel core.sound_cons.pos_neg_entails_bot)
      then show ?thesis
        by (smt (verit, ccfv_threshold) core.C_entails_fml Un_commute ai_in_asn_𝒞i
            consequence_relation.entails_cut core.fml_ext_is_mapping insert_is_Un
            core.sound_cons.ext_cons_rel) 
    qed
  qed
  then have fset (ffUnion (fimage neg |`| A_of |`| 𝒞s) |∪| A_of 𝒞)  total_strip J 
         ((core.fml_ext ` total_strip J)  {Pos (F_of 𝒞)}) ⊨s {Pos bot} for J 
    unfolding splittable_def
  proof -
    fix J
    assume fset (ffUnion (fimage neg |`| A_of |`| 𝒞s) |∪| A_of 𝒞)  total_strip J
    then have Ci_head_of_pair_entails_bot:
      AF.Pair Ci {|ai|} |∈| 𝒞s  (core.fml_ext ` total_strip J)  {Pos Ci} ⊨s {Pos bot}
      for Ci ai
      using all_Ci_entail_bot
      by blast
    then have Ci |∈| Cs  (core.fml_ext ` total_strip J)  {Pos Ci} ⊨s {Pos bot}
      for Ci
    proof -
      fix Ci
      assume Ci |∈| Cs
      then have  ai. AF.Pair Ci {|ai|} |∈| 𝒞s
        using split_all_pairs_in_Cs_in_As[OF split_cond] unfolding Cs_def by presburger
      then obtain ai where AF.Pair Ci {|ai|} |∈| 𝒞s
        by blast
      then show (core.fml_ext ` total_strip J)  {Pos Ci} ⊨s {Pos bot}
        using Ci_head_of_pair_entails_bot by blast
    qed
    then show (core.fml_ext ` total_strip J)  {Pos (F_of 𝒞)} ⊨s {Pos bot}
      using core.sound_cons.entails_of_entails_iff[OF F_of_𝒞_entails_Cs finite_image_Pos_Cs
          card_fset_Cs_ge_1] by blast
  qed
  then have
    fset (ffUnion (fimage neg |`| A_of |`| 𝒞s) |∪| A_of 𝒞)  total_strip J 
         ((core.fml_ext ` total_strip J)  Pos ` ({𝒞} projJ J)) ⊨s {Pos bot}
    for J 
    using split_cond by (simp add: core.enabled_def core.enabled_projection_def)

  then show {𝒞} ⊨sAF {AF.Pair bot (ffUnion (fimage neg |`| A_of |`| 𝒞s) |∪| A_of 𝒞)}
    unfolding core.AF_entails_sound_def using core.enabled_def core.enabled_set_def by simp
qed

lemma split_sound2: splittable 𝒞 𝒞s   𝒞'  fset 𝒞s. {𝒞} ⊨sAF {𝒞'}
proof
  fix 𝒞'
  assume split_cond: splittable 𝒞 𝒞s and 𝒞'_in: 𝒞' |∈| 𝒞s
  have C'' |∈| 𝒞s  fset (A_of C'')  total_strip J 
         (core.fml_ext ` total_strip J)  Pos ` ({𝒞} projJ J) ⊨s {Pos (F_of C'')} for J C''
  proof -
    fix J C''
    assume C''_in_As: C'' |∈| 𝒞s and
      A_of_C''_subset_J: fset (A_of C'')  total_strip J
    then have  ai. ai  asn (Pos (F_of C''))  A_of C'' = {| ai |}
      using split_all_assertion_sets_asn[OF split_cond C''_in_As] by blast
    then obtain ai where ai_in_asn_F_of_C'': ai  asn (Pos (F_of C'')) and
      A_of_C''_is: A_of C'' = {| ai |}
      by blast
    then show (core.fml_ext ` total_strip J)  Pos ` ({𝒞} projJ J) ⊨s {Pos (F_of C'')}
      by (smt (verit, best) A_of_C''_subset_J consequence_relation.entails_subsets empty_subsetI
          finsert.rep_eq core.fml_entails_C core.fml_ext_is_mapping image_eqI insert_is_Un 
          insert_subset core.sound_cons.ext_cons_rel sup_ge1)
  qed
  then have unfolded_AF_sound_entails: C''  fset 𝒞s  fset (A_of C'')  total_strip J 
         (core.fml_ext ` total_strip J)  Pos ` ({𝒞} projJ J) ⊨s {Pos (F_of C'')} for J C''
    by fast

  show {𝒞} ⊨sAF {𝒞'}
   unfolding core.AF_entails_sound_def core.enabled_set_def core.enabled_def
   using unfolded_AF_sound_entails[OF 𝒞'_in] split_cond 𝒞'_in by auto
qed

lemma split_simp: splittable 𝒞 𝒞s  𝒞  
  core.SRedF ({ AF.Pair bot (ffUnion ((|`|) neg |`| A_of |`| 𝒞s) |∪| A_of 𝒞) }  fset 𝒞s)
proof -
  assume split_cond: splittable 𝒞 𝒞s
  define Cs where Cs = F_of |`| 𝒞s
  then have F_of_𝒞_not_bot: F_of 𝒞  bot and
    fcard Cs  2 and
    {F_of 𝒞} ⊨s fset Cs and
    𝒞_red_to_splitted_𝒞s:  C'. C' |∈| Cs  F_of 𝒞  RedF {C'}
    using split_cond unfolding splittable_def split_form_def
    by blast+
  then have  J. core.enabled 𝒞 J 
    F_of 𝒞  RedF (({ AF.Pair bot (ffUnion (fimage neg |`| A_of |`| 𝒞s) |∪| A_of 𝒞) } projJ J)
     (fset 𝒞s projJ J))
  proof (intro allI impI)
    fix J
    assume 𝒞_enabled: core.enabled 𝒞 J
    then show
      F_of 𝒞  RedF (({ AF.Pair bot (ffUnion (fimage neg |`| A_of |`| 𝒞s) |∪| A_of 𝒞) } projJ J)
        (fset 𝒞s projJ J))
    proof (cases A. A |∈| A_of |`| 𝒞s  ( a. a |∈| A  a  total_strip J))
      case True
      then have ex_C_enabled_in_As:  C. C |∈| 𝒞s  core.enabled C J
        using core.enabled_def split_creates_singleton_assertion_sets split_cond
        by fastforce
      then have  C. C  fset 𝒞s projJ J
        by (simp add: core.enabled_projection_def)
      then show ?thesis
        using 𝒞_red_to_splitted_𝒞s split_cond core.Red_F_of_subset[of fset 𝒞s projJ J]
          mk_split_def by (smt (z3) CollectD Cs_def basic_trans_rules(31) core.enabled_projection_def
          core.sound_calculus_axioms insert_subset le_sup_iff sound_calculus.Red_F_of_subset
          split_all_pairs_in_As_in_Cs sup_bot.right_neutral sup_ge1)
    next
      case False
      then have fset 𝒞s projJ J = {}
        using split_creates_singleton_assertion_sets[OF split_cond]
        by (smt (verit, del_insts) Collect_empty_eq core.enabled_def core.enabled_projection_def
            fimage_finsert finsert.rep_eq finsertCI insert_subset mk_disjoint_finsert)
      moreover have  A. A |∈| A_of |`| 𝒞s  ( a. a |∈| A  ¬ a  total_strip J)
        using False
        by blast
      then have  A. A |∈| A_of |`| 𝒞s  ( a. a |∈| A  neg a  total_strip J)
        by auto
      then have fset (ffUnion ((fimage neg  A_of) |`| 𝒞s))  total_strip J
        by (smt (verit, best) fimage_iff fset.map_comp fset_ffUnion_subset_iff_all_fsets_subset subsetI)
      then have fset (ffUnion ((fimage neg  A_of) |`| 𝒞s) |∪| A_of 𝒞)  total_strip J
        using 𝒞_enabled
        by (simp add: core.enabled_def)
      then have {AF.Pair bot (ffUnion ((fimage neg  A_of) |`| 𝒞s) |∪| A_of 𝒞)} projJ J = {bot}
        unfolding core.enabled_projection_def core.enabled_def
        by auto
      ultimately show ?thesis
        by (simp add: F_of_𝒞_not_bot core.all_red_to_bot)
    qed
  qed
  then show 𝒞  core.SRedF ({ AF.Pair bot (ffUnion ((|`|) neg |`| A_of |`| 𝒞s) |∪| A_of 𝒞) }  fset 𝒞s)
    unfolding core.SRedF_def core.enabled_def
    by (intro UnI1) (smt (verit, ccfv_threshold) AF.collapse CollectI core.distrib_proj)
qed

sublocale empty_simps: AF_calculus_extended "to_AF bot" core.SInf "(⊨AF)" 
  "(⊨sAF)" core.SRedI core.SRedF "{}" "{}"
proof
  show core.SRedI N  core.SInf for N
    using core.SRedI_in_SInf .
next
  show N AF {to_AF bot}  N - core.SRedF N AF {to_AF bot} for N
    using core.SRedF_entails_bot .
next
  show N  N'  core.SRedF N  core.SRedF N' for N N'
    using core.SRedF_of_subset_F .
next
  show N  N'  core.SRedI N  core.SRedI N' for N N'
    using core.SRedI_of_subset_F .
next
  show N'  core.SRedF N  core.SRedF N  core.SRedF (N - N') for N N'
    using core.SRedF_of_SRedF_subset_F .
next
  show N'  core.SRedF N  core.SRedI N  core.SRedI (N - N') for N N'
    using core.SRedI_of_SRedF_subset_F .
next
  show ι  core.SInf  concl_of ι  N  ι  core.SRedI N for ι N
    using core.S_calculus.Red_I_of_Inf_to_N .
next
  show ι  {}  S_from ι - S_to ι  core.SRedF (S_to ι) for ι
    by simp
next
  show ι  {}  𝒞S_to ι. S_from ι ⊨sAF {𝒞} for ι
    by blast
next
  show ι  {}  set (prems_of ι) ⊨sAF {concl_of ι} for ι
    by blast
qed

lemma extend_simps_with_split:
  assumes
    AF_calculus_extended (to_AF bot) core.SInf (⊨AF) (⊨sAF) core.SRedI 
      core.SRedF Simps OptInfs
  shows
    AF_calculus_with_split (to_AF bot) core.SInf (⊨AF) (⊨sAF) core.SRedI core.SRedF Simps OptInfs
       splittable
proof -
  interpret sound_simps: AF_calculus_extended "to_AF bot" core.SInf "(⊨AF)"
    "(⊨sAF)" core.SRedI core.SRedF Simps OptInfs
    using assms .
  show ?thesis
  proof
    show splittable 𝒞 𝒞s 
    {𝒞} ⊨sAF {AF.Pair (F_of (to_AF bot)) (ffUnion ((|`|) neg |`| A_of |`| 𝒞s) |∪| A_of 𝒞)} for 𝒞 𝒞s
      using split_sound1 by (simp add: F_of_to_AF)
  next
    show splittable 𝒞 𝒞s  𝒞'|∈|𝒞s. {𝒞} ⊨sAF {𝒞'} for 𝒞 𝒞s
      using split_sound2 .
  next
    show splittable 𝒞 𝒞s  𝒞  core.SRedF 
    ({AF.Pair (F_of (to_AF bot)) (ffUnion ((|`|) neg |`| A_of |`| 𝒞s) |∪| A_of 𝒞)}  fset 𝒞s)
      for 𝒞 𝒞s
      using split_simp by (simp add: F_of_to_AF)
  qed
qed

interpretation splitting_calc_with_split:
  AF_calculus_with_split "to_AF bot" core.SInf "(⊨AF)" "(⊨sAF)" core.SRedI core.SRedF "{}" "{}" splittable
  using extend_simps_with_split[OF empty_simps.AF_calculus_extended_axioms] .

end (* locale splitting_calculus *)

subsubsection ‹The Collect Rule›

locale AF_calculus_with_collect =  base_calculus: AF_calculus_extended bot SInf
  entails entails_sound SRedI SRedF Simps OptInfs
  for bot :: ('f, 'v :: countable) AF and
      SInf :: ('f, 'v) AF inference set and
      entails :: ('f, 'v) AF set  ('f, 'v) AF set  bool (infix AF 50) and
      entails_sound :: ('f, 'v) AF set  ('f, 'v) AF set  bool (infix ⊨sAF 50) and
      SRedI :: ('f, 'v) AF set  ('f, 'v) AF inference set and
      SRedF :: ('f, 'v) AF set  ('f, 'v) AF set and
      Simps :: ('f, 'v) AF simplification set and
      OptInfs :: ('f, 'v) AF inference set
  + assumes
    collect_redundant: F_of 𝒞  F_of bot   AF {AF.Pair (F_of bot) (A_of 𝒞)}  
      ( 𝒞  . F_of 𝒞 = F_of bot)  𝒞  SRedF 
begin

interpretation AF_sound_cons_rel: consequence_relation bot (⊨sAF)
  using base_calculus.sc.sound_cons.consequence_relation_axioms .

interpretation SInf_sound_inf_system: sound_inference_system SInf bot (⊨sAF)
  using base_calculus.sc.sound_inference_system_axioms .

abbreviation collect_pre :: ('f, 'v) AF  ('f, 'v) AF set  bool where
  collect_pre 𝒞   
    F_of 𝒞  F_of bot   AF {AF.Pair (F_of bot) (A_of 𝒞)}  ( 𝒞  . F_of 𝒞 = F_of bot)

abbreviation collect_simp :: ('f, 'v) AF  ('f, 'v) AF set  ('f, 'v) AF simplification where
  collect_simp 𝒞   Simplify (insert 𝒞 ) 

(* Report definition 9 (Collect only) *)
inductive_set Simps_with_Collect :: ('f, 'v) AF simplification set where
  collect: collect_pre 𝒞   collect_simp 𝒞   Simps_with_Collect
| other: ι  Simps  ι  Simps_with_Collect

(*
lemma no_infinite_simp_set: ‹finite (S_from ι) ⟹ ι ∈ Simps_with_Collect ⟹ finite (S_to ι)›
  using Simps_with_Collect.cases base_calculus.no_infinite_simps by force 
*)

(* Report theorem 14 for simps extended with Collect *)
theorem SInf_with_collect_sound_wrt_entails_sound: 
  ι  Simps_with_Collect   𝒞  S_to ι. S_from ι ⊨sAF {𝒞}
proof -
  assume ι_is_simp_rule: ι  Simps_with_Collect
  then show  𝒞  S_to ι. S_from ι ⊨sAF {𝒞}
  proof (intro ballI)
    fix 𝒞
    assume 𝒞_is_consq_of_ι: 𝒞  S_to ι
    show S_from ι ⊨sAF {𝒞}
      using ι_is_simp_rule
    proof (cases rule: Simps_with_Collect.cases)
      case (collect 𝒞' 𝒩)
      then show ?thesis
        using 𝒞_is_consq_of_ι by (metis base_calculus.sc.sound_cons.entails_conjunctive_def 
            base_calculus.sc.sound_cons.subset_entailed simplification.sel(1) simplification.sel(2)
            subset_insertI)
    next
      case other
      then show ?thesis
        using base_calculus.simps_sound 𝒞_is_consq_of_ι by auto
    qed
  qed
qed

(* Report theorem 19 for Collect *)
theorem simps_with_collect_are_simps: 
  ι  Simps_with_Collect  (S_from ι - S_to ι)  SRedF (S_to ι)
proof
  fix 𝒞
  assume ι_is_simp_rule: ι  Simps_with_Collect and
    C_in: 𝒞  S_from ι - S_to ι
  then show 𝒞  SRedF (S_to ι)
  proof (cases rule: Simps_with_Collect.cases)
    case (collect 𝒞' )
    then have 𝒞 = 𝒞'
      using C_in by auto
    moreover have S_to ι = 
      using collect(1) by simp
    ultimately show ?thesis
      using collect_redundant[OF collect(2)] by blast
  next
    case other
    then show ?thesis
      using base_calculus.simps_simp C_in by blast
  qed
qed

sublocale AF_calc_ext: AF_calculus_extended bot SInf entails entails_sound SRedI SRedF
  Simps_with_Collect OptInfs
  using simps_with_collect_are_simps SInf_with_collect_sound_wrt_entails_sound (*no_infinite_simp_set*)
    base_calculus.infs_sound by (unfold_locales, auto)

end (* locale AF_calculus_with_collect *)

context splitting_calculus
begin

(* part of report theorem 19 for Collect *)
lemma collect_redundant: F_of 𝒞  bot   AF {AF.Pair bot (A_of 𝒞)}  
      ( 𝒞  . F_of 𝒞 = bot)  𝒞  core.SRedF 
proof -
  assume F_of 𝒞  bot   AF {AF.Pair bot (A_of 𝒞)}  ( 𝒞  . F_of 𝒞 = bot)
  then have head_𝒞_not_bot: F_of 𝒞  bot and
      ℳ_entails_bot_𝒞:  AF {AF.Pair bot (A_of 𝒞)} and
      all_heads_are_bot_in_ℳ:  𝒞  . F_of 𝒞 = bot
    by auto
  have  J. ( 𝒞'  . core.enabled 𝒞' J)  core.enabled 𝒞 J 
           F_of 𝒞  RedF ( projJ J) and
        J. ¬ ( 𝒞'  . core.enabled 𝒞' J)  core.enabled 𝒞 J  False
  proof -
    fix J
    assume 𝒞_enabled: core.enabled 𝒞 J and
            𝒞'  . core.enabled 𝒞' J
    then have  projJ J = {bot}
      using all_heads_are_bot_in_ℳ unfolding core.enabled_projection_def by fast
    then show F_of 𝒞  RedF ( projJ J)
      using core.all_red_to_bot[OF head_𝒞_not_bot] by simp
  next
    fix J
    assume 𝒞_enabled: core.enabled 𝒞 J and
           ¬ ( 𝒞'  . core.enabled 𝒞' J)
    then have ℳ_proj_J_empty:  projJ J = {}
      unfolding core.enabled_projection_def by blast
    moreover have core.enabled (AF.Pair bot (A_of 𝒞)) J
      using 𝒞_enabled by (auto simp add: core.enabled_def)
    ultimately have {}  {bot}
      using ℳ_entails_bot_𝒞 using core.AF_entails_def by auto
    then show False
      using core.entails_bot_to_entails_empty core.entails_nontrivial by blast
  qed
  then show 𝒞  core.SRedF 
    unfolding core.SRedF_def core.enabled_def by (smt (verit, ccfv_SIG) AF.collapse CollectI UnI1)
qed


lemma extend_simps_with_collect: 
  assumes
    AF_calculus_extended (to_AF bot) core.SInf (⊨AF) (⊨sAF) core.SRedI 
      core.SRedF Simps OptInfs
  shows
    AF_calculus_with_collect (to_AF bot) core.SInf (⊨AF) (⊨sAF) core.SRedI core.SRedF Simps OptInfs
proof -
  interpret sound_simps: 
    AF_calculus_extended "to_AF bot" core.SInf "(⊨AF)" "(⊨sAF)" core.SRedI
      core.SRedF Simps
    using assms .
  show ?thesis
  proof
    fix 𝒞 
    show F_of 𝒞  F_of (to_AF bot)   AF {AF.Pair (F_of (to_AF bot)) (A_of 𝒞)}  
      (𝒞. F_of 𝒞 = F_of (to_AF bot))  𝒞  core.SRedF 
      using collect_redundant by (simp add: F_of_to_AF)
  qed
qed

interpretation splitting_calc_with_collect:
  AF_calculus_with_collect "to_AF bot" core.SInf "(⊨AF)" "(⊨sAF)" core.SRedI core.SRedF "{}" "{}"
  using extend_simps_with_collect[OF empty_simps.AF_calculus_extended_axioms] .

end (* context splitting_calculus *)

subsubsection ‹The Trim Rule›

locale AF_calculus_with_trim =  base_calculus: AF_calculus_extended bot SInf 
  entails entails_sound SRedI SRedF Simps OptInfs
  for bot :: ('f, 'v :: countable) AF and
      SInf :: ('f, 'v) AF inference set and
      entails :: ('f, 'v) AF set  ('f, 'v) AF set  bool (infix AF 50) and
      entails_sound :: ('f, 'v) AF set  ('f, 'v) AF set  bool (infix ⊨sAF 50) and
      SRedI :: ('f, 'v) AF set  ('f, 'v) AF inference set and
      SRedF :: ('f, 'v) AF set  ('f, 'v) AF set and
      Simps :: ('f, 'v) AF simplification set and
      OptInfs :: ('f, 'v) AF inference set
  + assumes
    trim_sound: A_of 𝒞 = A |∪| B  F_of 𝒞  F_of bot  
        {AF.Pair (F_of bot) A} ⊨sAF {AF.Pair (F_of bot) B} 
      (𝒞. F_of 𝒞 = (F_of bot))  A |∩| B = {||}  A  {||}
         insert 𝒞  ⊨sAF {AF.Pair (F_of 𝒞) B} and
    trim_redundant: A_of 𝒞 = A |∪| B  F_of 𝒞  F_of bot  
        {AF.Pair (F_of bot) A} ⊨sAF {AF.Pair (F_of bot) B} 
      (𝒞. F_of 𝒞 = (F_of bot))  A |∩| B = {||}  A  {||}
         𝒞  SRedF (  { AF.Pair (F_of 𝒞) B })

begin

interpretation AF_sound_cons_rel: consequence_relation bot (⊨sAF)
  using base_calculus.sc.sound_cons.consequence_relation_axioms .

interpretation SInf_sound_inf_system: sound_inference_system SInf bot (⊨sAF)
  using base_calculus.sc.sound_inference_system_axioms .

abbreviation trim_pre :: ('f, 'v) AF  'v sign fset  'v sign fset  ('f, 'v) AF set  bool where
  trim_pre 𝒞 A B   A_of 𝒞 = A |∪| B  F_of 𝒞  F_of bot 
                         { AF.Pair (F_of bot) A } ⊨sAF { AF.Pair (F_of bot) B } 
                       ( 𝒞  . F_of 𝒞 = (F_of bot))  A |∩| B = {||}  A  {||}

abbreviation trim_simp :: ('f, 'v) AF  'v sign fset  'v sign fset  ('f, 'v) AF set 
  ('f, 'v) AF simplification where
  trim_simp 𝒞 A B   Simplify (insert 𝒞 ) (insert (AF.Pair (F_of 𝒞) B) )

(* Report definition 9 (Trim only) *)
inductive_set Simps_with_Trim :: ('f, 'v) AF simplification set where
  trim: trim_pre 𝒞 A B   trim_simp 𝒞 A B   Simps_with_Trim
| other: ι  Simps  ι  Simps_with_Trim

(*
lemma no_infinite_simp_set: ‹finite (S_from ι) ⟹ ι ∈ Simps_with_Trim ⟹ finite (S_to ι)›
  using Simps_with_Trim.cases base_calculus.no_infinite_simps by force
*)

theorem SInf_with_trim_sound_wrt_entails_sound: 
  ι  Simps_with_Trim   𝒞  S_to ι. S_from ι ⊨sAF {𝒞}
proof -
  assume ι_is_simp_rule: ι  Simps_with_Trim
  then show  𝒞  S_to ι. S_from ι ⊨sAF {𝒞}
  proof (intro ballI)
    fix 𝒞
    assume 𝒞_is_consq_of_ι: 𝒞  S_to ι
    show S_from ι ⊨sAF {𝒞}
      using ι_is_simp_rule
    proof (cases rule: Simps_with_Trim.cases)
      case (trim 𝒞' A B 𝒩)
      then have A_of 𝒞' = A |∪| B and
        F_of 𝒞'  F_of bot and
        𝒩_and_Pair_bot_A_entails_Pair_bot_B: 
        𝒩  {AF.Pair (F_of bot) A} ⊨sAF {AF.Pair (F_of bot) B} and
        all_heads_in_𝒩_are_bot: ( 𝒞  𝒩. F_of 𝒞 = F_of bot) and
        A |∩| B = {||} and
        A  {||}
        by blast+
      consider 𝒞 = AF.Pair (F_of 𝒞') B | 𝒞  𝒩
        using 𝒞_is_consq_of_ι trim(1) by auto
      then show ?thesis
      proof cases
        case 1
        then show ?thesis
          using trim_sound[OF trim(2)] trim(1) by fastforce
      next
        case 2
        then show ?thesis
          using trim(1) by (metis base_calculus.sc.sound_cons.entails_reflexive 
              base_calculus.sc.sound_cons.entails_subsets empty_subsetI insertI2 insert_subset
              simplification.sel(1) subset_singleton_iff)
      qed
    next
      case other
      show ?thesis
        using base_calculus.simps_sound[OF other] 𝒞_is_consq_of_ι by auto
    qed
  qed
qed

(* Report theorem 19 for Trim *)
theorem simps_with_trim_are_simps: 
  ι  Simps_with_Trim  (S_from ι - S_to ι)  SRedF (S_to ι)
proof
  fix 𝒞
  assume ι  Simps_with_Trim and
    C_in: 𝒞  S_from ι - S_to ι
  then show 𝒞  SRedF (S_to ι)
  proof (cases rule: Simps_with_Trim.cases)
    case (trim 𝒞' A B )
    then have 𝒞' = 𝒞 using C_in by auto
    then show ?thesis
      using trim_redundant[OF trim(2)] trim(1) by simp
  next
    case other
    then show ?thesis
      using base_calculus.simps_simp C_in by auto
  qed
qed

sublocale AF_calc_ext: AF_calculus_extended bot SInf entails entails_sound SRedI SRedF
  Simps_with_Trim OptInfs
  using simps_with_trim_are_simps SInf_with_trim_sound_wrt_entails_sound (*no_infinite_simp_set*)
    base_calculus.infs_sound by (unfold_locales, auto)

end (* locale AF_calculus_with_trim *)

context splitting_calculus
begin

lemma trim_sound: A_of 𝒞' = A |∪| B  F_of 𝒞'  bot  
      𝒩  {AF.Pair bot A} ⊨sAF {AF.Pair bot B} 
      (𝒞𝒩. F_of 𝒞 = bot)  A |∩| B = {||}  A  {||}
         𝒞 = AF.Pair (F_of 𝒞') B  insert 𝒞' 𝒩 ⊨sAF {𝒞}
proof -
  assume A_of 𝒞' = A |∪| B  F_of 𝒞'  bot  
      𝒩  {AF.Pair bot A} ⊨sAF {AF.Pair bot B} 
      (𝒞𝒩. F_of 𝒞 = bot)  A |∩| B = {||}  A  {||} and
    C_is: 𝒞 = AF.Pair (F_of 𝒞') B
  then have A_of_Cp: A_of 𝒞' = A |∪| B and
    F_of_Cp: F_of 𝒞'  bot and
    A_in_N_entails_B: AF.Pair bot A  𝒩 ⊨sAF {AF.Pair bot B} and
    all_heads_in_𝒩_are_bot: ( 𝒞  𝒩. F_of 𝒞 = bot) and
    A_int_B: A |∩| B = {||} and
    A_neq: A  {||}
    by auto
  have 𝒩_and_Pair_bot_A_entails_Pair_bot_B: 𝒩  {AF.Pair bot A} ⊨sAF {AF.Pair bot B}
    using A_in_N_entails_B by auto
  let ?𝒞 = AF.Pair (F_of 𝒞') B
  have neg_entails_version:
    core.enabled  ?𝒞 J 
           core.fml_ext ` total_strip J  Pos ` (insert (AF.Pair (F_of 𝒞') A) 𝒩 projJ J)
             ⊨s {Pos (F_of ?𝒞)}
    for J
  proof -
    fix J
    assume core.enabled ?𝒞 J
    then have B_in_J: fset B  total_strip J
      by (simp add: core.enabled_def)
    then consider (fml_unsat) core.sound_cons.entails_neg (core.fml_ext ` total_strip J) {Pos bot} |
      (𝒩_unsat)  A'  A_of ` 𝒩. fset A'  total_strip J |
      (A_subset_J) fset A  total_strip J
      using core.strong_entails_bot_cases[OF 𝒩_and_Pair_bot_A_entails_Pair_bot_B, rule_format,
          OF B_in_J]
        core.strong_entails_bot_cases_Union[rule_format, OF _ _ B_in_J]
      by (smt (verit, ccfv_SIG) Un_commute core.enabled_def core.enabled_projection_def equals0I
          image_iff mem_Collect_eq sup_bot_left)
    then show
      core.fml_ext ` total_strip J  Pos ` (insert (AF.Pair (F_of 𝒞') A) 𝒩 projJ J)
               ⊨s {Pos (F_of ?𝒞)}
    proof cases
      case fml_unsat
      then have (core.fml_ext ` total_strip J) ⊨s {Pos bot, Pos (F_of 𝒞')}
        by (smt (verit, best) Un_absorb consequence_relation.entails_subsets insert_is_Un
            core.sound_cons.ext_cons_rel sup_ge1)
      moreover have ((core.fml_ext ` total_strip J)  {Pos bot}) ⊨s {Pos (F_of 𝒞')}
        by (smt (verit, del_insts) Un_commute Un_upper2 empty_subsetI insert_subset
            mem_Collect_eq core.sound_cons.bot_entails_empty core.sound_cons.entails_neg_def
            core.sound_cons.entails_subsets)
      ultimately have (core.fml_ext ` total_strip J) ⊨s {Pos (F_of 𝒞')}
        using consequence_relation.entails_cut core.sound_cons.ext_cons_rel
        by fastforce
      then show ?thesis
        by (smt (verit, best) AF.sel(1) consequence_relation.entails_subsets
            insert_is_Un core.sound_cons.ext_cons_rel sup_ge1)
    next
      case 𝒩_unsat
      then have bot  𝒩 projJ J
        unfolding core.enabled_projection_def core.enabled_def
        using all_heads_in_𝒩_are_bot by fastforce
      then have (Pos ` (𝒩 projJ J)) ⊨s {}
        by (smt (verit, del_insts) consequence_relation.bot_entails_empty
            consequence_relation.entails_subsets image_insert insert_is_Un mk_disjoint_insert
            core.sound_cons.ext_cons_rel sup_bot_right sup_ge1)
      then show ?thesis
        by (smt (verit, ccfv_threshold) Un_upper2 consequence_relation.entails_subsets
            core.distrib_proj image_Un insert_is_Un core.sound_cons.ext_cons_rel sup_assoc)
    next
      case A_subset_J
      then have pair_bot_A_enabled: core.enabled (AF.Pair bot A) J
        by (simp add: core.enabled_def)
      then have {Pos (F_of 𝒞')} ⊨s {Pos (F_of 𝒞')}
        by (meson consequence_relation.entails_reflexive core.sound_cons.ext_cons_rel)
      then have (Pos ` ({AF.Pair (F_of 𝒞') A} projJ J)) ⊨s {Pos (F_of 𝒞')}
        using pair_bot_A_enabled  core.enabled_def core.enabled_projection_def
        by force
      then show ?thesis
        by (smt (verit, ccfv_threshold) AF.sel(1) Un_commute Un_upper2
            consequence_relation.entails_subsets core.distrib_proj image_Un insert_is_Un
            core.sound_cons.ext_cons_rel)
    qed
  qed
  have trim_assms: A_of 𝒞' = A |∪| B  F_of 𝒞'  bot  𝒩  {AF.Pair bot A} ⊨sAF {AF.Pair bot B} 
   (𝒞𝒩. F_of 𝒞 = bot)  A |∩| B = {||}  A  {||}
    using A_of_Cp F_of_Cp 𝒩_and_Pair_bot_A_entails_Pair_bot_B all_heads_in_𝒩_are_bot A_int_B A_neq
    by blast
  have 𝒞'  𝒩 ⊨sAF {?𝒞}
    unfolding core.AF_entails_sound_def core.enabled_set_def
    by (smt (verit, ccfv_threshold) AF.collapse AF.sel(2) A_of_Cp core.distrib_proj core.enabled_def
        core.projection_of_enabled_subset image_empty image_insert insertCI insert_is_Un 
        neg_entails_version)
  then show insert 𝒞' 𝒩 ⊨sAF {𝒞}
    using C_is by auto
qed

(* part of Report theorem 19 for Trim *)
theorem trim_redundant: A_of 𝒞 = A |∪| B 
       F_of 𝒞  bot 
         {AF.Pair bot A} ⊨sAF {AF.Pair bot B} 
       (𝒞. F_of 𝒞 = bot)  A |∩| B = {||}  A  {||} 
 𝒞  core.SRedF (  { AF.Pair (F_of 𝒞) B })
proof -
  assume A_of 𝒞 = A |∪| B  F_of 𝒞  bot    {AF.Pair bot A} ⊨sAF {AF.Pair bot B} 
       (𝒞. F_of 𝒞 = bot)  A |∩| B = {||}  A  {||}
  then have  A_of_𝒞_is: A_of 𝒞 = A |∪| B and
            F_of 𝒞  bot and
            ℳ_and_A_entail_bot_B: AF.Pair bot A   ⊨sAF {AF.Pair bot B} and
            𝒞  . F_of 𝒞 = bot and
            A_B_disjoint: A |∩| B = {||} and
            A_not_empty: A  {||}
    by auto
  then have  𝒞'    {AF.Pair (F_of 𝒞) B}. (F_of 𝒞' = F_of 𝒞  A_of 𝒞' |⊂| A_of 𝒞)
    by auto
  then show 𝒞  core.SRedF (  { AF.Pair (F_of 𝒞) B })
    unfolding core.SRedF_def
    by (smt (verit, del_insts) AF.collapse CollectI Un_iff insert_iff singletonD)
qed

lemma extend_simps_with_trim: 
  assumes
    AF_calculus_extended (to_AF bot) core.SInf (⊨AF) (⊨sAF) core.SRedI 
      core.SRedF Simps OptInfs
  shows
    AF_calculus_with_trim (to_AF bot) core.SInf (⊨AF) (⊨sAF) core.SRedI core.SRedF Simps OptInfs
proof -
  interpret sound_simps: 
    AF_calculus_extended "to_AF bot" core.SInf "(⊨AF)" "(⊨sAF)" core.SRedI 
      core.SRedF Simps OptInfs
    using assms .
  show ?thesis
  proof
    fix 𝒞 A B 
    assume A_of 𝒞 = A |∪| B 
       F_of 𝒞  F_of (to_AF bot) 
         {AF.Pair (F_of (to_AF bot)) A} ⊨sAF {AF.Pair (F_of (to_AF bot)) B} 
       (𝒞. F_of 𝒞 = F_of (to_AF bot))  A |∩| B = {||}  A  {||}
    then show 𝒞   ⊨sAF {AF.Pair (F_of 𝒞) B}
      using trim_sound F_of_to_AF by metis
  next
    fix 𝒞 A B 
    assume A_of 𝒞 = A |∪| B 
       F_of 𝒞  F_of (to_AF bot) 
         {AF.Pair (F_of (to_AF bot)) A} ⊨sAF {AF.Pair (F_of (to_AF bot)) B} 
       (𝒞. F_of 𝒞 = F_of (to_AF bot))  A |∩| B = {||}  A  {||}
    then show 𝒞  core.SRedF (  {AF.Pair (F_of 𝒞) B})
      using trim_redundant F_of_to_AF by metis
  qed
qed

interpretation splitting_calc_with_trim:
  AF_calculus_with_trim "to_AF bot" core.SInf "(⊨AF)" "(⊨sAF)" core.SRedI core.SRedF "{}" "{}"
  using extend_simps_with_trim[OF empty_simps.AF_calculus_extended_axioms] .

end (* context splitting_calculus *)


subsection ‹Extra Inferences›

text ‹
  We extend our basic splitting calculus with new optional rules:
   \textsc{StrongUnsat} is a variant of \textsc{Unsat} which uses the sound entailment
    instead of the "normal" entailment;
   \textsc{Approx} is a very special case for \textsc{Split} where $n = 1$;
   \textsc{Tauto} inserts a new formula which is always true.
›

subsubsection ‹The StrongUnsat Rule›

locale AF_calculus_with_strong_unsat = 
  base: AF_calculus_extended bot SInf entails entails_sound Red_I Red_F Simps
    OptInfs
  for bot :: ('f, 'v :: countable) AF and
      SInf :: ('f, 'v) AF inference set and
      entails :: ('f, 'v) AF set  ('f, 'v) AF set  bool and
      entails_sound :: ('f, 'v) AF set  ('f, 'v) AF set  bool (infix ⊨sAF 50) and
      Red_I :: ('f, 'v) AF set  ('f, 'v) AF inference set and
      Red_F :: ('f, 'v) AF set  ('f, 'v) AF set and
      Simps :: ('f, 'v) AF simplification set and
      OptInfs :: ('f, 'v) AF inference set
begin

text ‹
  We follow the same naming conventions for our new inference rules as for the two inference rules
  defined in @{locale annotated_calculus}.
  $X\_inf$ defines the inference rule, while $X\_pre$ is the precondition for the application of
  the inference rule.
›

abbreviation strong_unsat_pre :: ('f, 'v) AF list  bool where
  strong_unsat_pre   (set  ⊨sAF {bot})  ( x  set . F_of x = (F_of bot))

abbreviation strong_unsat_inf :: ('f, 'v) AF list  ('f, 'v) AF inference where
  strong_unsat_inf   Infer  bot

text ‹Instead of considering an inference system with only the new rule, here \textsc{StrongUnsat},
  we instead add it to the inference system provided so that it is possible to extend the system 
  rule by rule in a modular way.› 
  
(* Report definition 9 (cont) *)
inductive_set OptInfs_with_strong_unsat :: ('f, 'v) AF inference set where
  strong_unsat: strong_unsat_pre   strong_unsat_inf   OptInfs_with_strong_unsat
| from_OptInf: ι  OptInfs  ι  OptInfs_with_strong_unsat

(* Report theorem 14 for StrongUnsat *)
theorem OptInf_with_strong_unsat_sound_wrt_entails_sound: 
  ι  OptInfs_with_strong_unsat  set (prems_of ι) ⊨sAF {concl_of ι}
proof -
  assume ι  OptInfs_with_strong_unsat
  then show ?thesis
  proof (cases ι rule: OptInfs_with_strong_unsat.cases)
    case (strong_unsat )
    then show ?thesis
      by simp
  next
    case from_OptInf
    then show ?thesis
      using base.infs_sound by blast 
  qed
qed

interpretation AF_sound_cons_rel: consequence_relation bot (⊨sAF)
  using base.sc.sound_cons.consequence_relation_axioms .

interpretation SInf_sound_inf_system: sound_inference_system SInf bot (⊨sAF)
  using base.sc.sound_inference_system_axioms .

definition Red_I_ext where
  Red_I_ext 𝒩 = Red_I 𝒩  { strong_unsat_inf  | . strong_unsat_pre   bot  𝒩 }

interpretation AF_calc_with_strong_unsat: 
  AF_calculus bot SInf entails entails_sound Red_I Red_F
  using base.AF_calculus_axioms .

sublocale AF_calc_ext: AF_calculus_extended bot SInf entails entails_sound Red_I Red_F
  Simps OptInfs_with_strong_unsat
  using base.simps_simp base.simps_sound (*base.no_infinite_simps *)
OptInf_with_strong_unsat_sound_wrt_entails_sound
  by (unfold_locales, auto)

end (* locale AF_calculus_with_strong_unsat *)

context splitting_calculus
begin

lemma extend_infs_with_strong_unsat: 
  assumes
    AF_calculus_extended (to_AF bot) core.SInf (⊨AF) (⊨sAF) core.SRedI 
      core.SRedF Simps OptInfs
  shows
    AF_calculus_with_strong_unsat (to_AF bot) core.SInf (⊨AF) (⊨sAF) core.SRedI core.SRedF Simps 
      OptInfs
  using AF_calculus_with_strong_unsat.intro assms by blast

interpretation splitting_calc_with_strong_unsat: AF_calculus_with_strong_unsat "to_AF bot" core.SInf
  "(⊨AF)" "(⊨sAF)" core.SRedI core.SRedF "{}" "{}"
  using 
    extend_infs_with_strong_unsat[OF empty_simps.AF_calculus_extended_axioms] .

end (* context splitting_calculus *)

subsubsection ‹The Tauto Rule›

locale AF_calculus_with_tauto = 
  base: AF_calculus_extended bot SInf entails entails_sound Red_I Red_F Simps
  OptInfs
  for bot :: ('f, 'v :: countable) AF and
      SInf :: ('f, 'v) AF inference set and
      entails :: ('f, 'v) AF set  ('f, 'v) AF set  bool and
      entails_sound :: ('f, 'v) AF set  ('f, 'v) AF set  bool (infix ⊨sAF 50) and
      Red_I :: ('f, 'v) AF set  ('f, 'v) AF inference set and
      Red_F :: ('f, 'v) AF set  ('f, 'v) AF set and
      Simps :: ('f, 'v) AF simplification set and
      OptInfs :: ('f, 'v) AF inference set
begin

abbreviation tauto_pre :: ('f, 'v) AF  bool where
  tauto_pre 𝒞  {} ⊨sAF { 𝒞 }

abbreviation tauto_inf :: ('f, 'v) AF  ('f, 'v) AF inference where
  tauto_inf 𝒞  Infer [] 𝒞

(* Report definition 9 (cont) *)
inductive_set OptInfs_with_tauto :: ('f, 'v) AF inference set where
  tauto: tauto_pre 𝒞  tauto_inf 𝒞  OptInfs_with_tauto
| from_OptInfs: ι  OptInfs  ι  OptInfs_with_tauto 

(* Report theorem 14 for Tauto *)
theorem OptInfs_with_tauto_sound_wrt_entails_sound: ι  OptInfs_with_tauto  
  set (prems_of ι) ⊨sAF {concl_of ι}
proof -
  assume ι  OptInfs_with_tauto
  then show ?thesis
  proof (cases ι rule: OptInfs_with_tauto.cases)
    case (tauto 𝒞)
    then show ?thesis
      by auto
  next
    case from_OptInfs
    then show ?thesis
      using base.infs_sound by blast
  qed
qed

sublocale AF_calc_ext: AF_calculus_extended bot SInf entails "(⊨sAF)" Red_I 
  Red_F Simps OptInfs_with_tauto
  using OptInfs_with_tauto_sound_wrt_entails_sound base.simps_sound base.simps_simp 
  by (unfold_locales, auto)

end (* locale AF_calculus_with_tauto *)

context splitting_calculus
begin


lemma extend_infs_with_tauto: 
  assumes
    AF_calculus_extended (to_AF bot) core.SInf (⊨AF) (⊨sAF) core.SRedI 
      core.SRedF Simps OptInfs
  shows
    AF_calculus_with_tauto (to_AF bot) core.SInf (⊨AF) (⊨sAF) core.SRedI core.SRedF Simps OptInfs
  using AF_calculus_with_tauto.intro assms by blast


interpretation splitting_calc_with_tauto:
  AF_calculus_with_tauto "to_AF bot" core.SInf "(⊨AF)" "(⊨sAF)" core.SRedI core.SRedF "{}" "{}"
  using extend_infs_with_tauto[OF empty_simps.AF_calculus_extended_axioms] .

end (* context splitting_calculus *)

subsubsection ‹The Approx Rule›

locale AF_calculus_with_approx = 
  base: AF_calculus_extended bot SInf entails entails_sound Red_I Red_F Simps
    OptInfs
  for bot :: ('f, 'v :: countable) AF and
      SInf :: ('f, 'v) AF inference set and
      entails :: ('f, 'v) AF set  ('f, 'v) AF set  bool and
      entails_sound :: ('f, 'v) AF set  ('f, 'v) AF set  bool (infix ⊨sAF 50) and
      Red_I :: ('f, 'v) AF set  ('f, 'v) AF inference set and
      Red_F :: ('f, 'v) AF set  ('f, 'v) AF set and
      Simps :: ('f, 'v) AF simplification set and
      OptInfs :: ('f, 'v) AF inference set
  + fixes
      approximates :: 'v sign  ('f, 'v) AF  bool
    assumes
      approx_sound: approximates a 𝒞  {𝒞} ⊨sAF {AF.Pair (F_of bot) (finsert (neg a) (A_of 𝒞))}
begin

abbreviation approx_pre :: 'v sign  ('f, 'v) AF  bool where
  approx_pre a 𝒞  approximates a 𝒞

abbreviation approx_inf :: ('f, 'v) AF  'v sign  ('f, 'v) AF inference where
  approx_inf 𝒞 a  Infer [𝒞] (AF.Pair (F_of bot) (finsert (neg a) (A_of 𝒞)))
  
(* Report definition 9 (cont) *)
inductive_set OptInfs_with_approx :: ('f, 'v) AF inference set where
  approx: approx_pre a 𝒞  approx_inf 𝒞 a  OptInfs_with_approx
| from_OptInfs: ι  OptInfs  ι  OptInfs_with_approx 

(* Report theorem 14 for Approx *)
theorem OptInfs_with_approx_sound_wrt_entails_sound:
  ι  OptInfs_with_approx  set (prems_of ι) ⊨sAF {concl_of ι}
proof -
  assume ι  OptInfs_with_approx
  then show ?thesis
  proof (cases ι rule: OptInfs_with_approx.cases)
    case (approx a 𝒞)
    show ?thesis
      using approx_sound[OF approx(2)] approx(1) by simp
  next
    case from_OptInfs
    show ?thesis
      using base.infs_sound[OF from_OptInfs] .
  qed
qed

sublocale AF_calc_ext: AF_calculus_extended bot SInf entails "(⊨sAF)" Red_I Red_F Simps
  OptInfs_with_approx
  using OptInfs_with_approx_sound_wrt_entails_sound base.simps_sound base.simps_simp 
  by (unfold_locales, auto)

end (* locale AF_calculus_with_approx *)

context splitting_calculus
begin

definition approximates :: 'v sign  ('f, 'v) AF  bool where
  approximates a 𝒞  a  asn (Pos (F_of 𝒞))

lemma approx_sound: approximates a 𝒞  {𝒞} ⊨sAF {AF.Pair bot (finsert (neg a) (A_of 𝒞))}
proof -
  assume approx_a_C: approximates a 𝒞
  then have
    core.enabled (AF.Pair bot (finsert (neg a) (A_of 𝒞))) J 
       (core.fml_ext ` total_strip J)  {Pos (F_of 𝒞)} ⊨s {Pos bot}
    for J 
  proof -
    fix J
    assume core.enabled (AF.Pair bot (finsert (neg a) (A_of 𝒞))) J
    then have fset (finsert (neg a) (A_of 𝒞))  total_strip J
      unfolding core.enabled_def
      by simp
    then have neg_fml_ext_in_J: neg (core.fml_ext a)  core.fml_ext ` total_strip J
      by (smt (verit, ccfv_threshold) finsert.rep_eq core.fml_ext.elims core.fml_ext.simps(1)
          core.fml_ext.simps(2) image_iff insert_subset neg.simps(1) neg.simps(2))
    moreover have {Pos (F_of 𝒞)} ⊨s {Pos (F_of 𝒞)}
      using core.equi_entails_if_a_in_asns approx_a_C unfolding approximates_def
      by blast
    then have (core.fml_ext ` (total_strip J - {neg a}))  {Pos (F_of 𝒞)} ⊨s 
        {Pos bot, Pos (F_of 𝒞)}
      by (metis (no_types, lifting) consequence_relation.entails_subsets insert_is_Un
          core.sound_cons.ext_cons_rel sup.cobounded2)
    ultimately show (core.fml_ext ` total_strip J)  {Pos (F_of 𝒞)} ⊨s {Pos bot}
    proof -
      have core.fml_ext ` total_strip J  {core.fml_ext a} ⊨s ({Pos bot}  {})
        by (smt (z3) Bex_def_raw UnCI Un_commute Un_insert_right Un_upper2 neg_fml_ext_in_J
            consequence_relation.entails_subsets insert_is_Un insert_subset
            core.sound_cons.ext_cons_rel core.sound_cons.pos_neg_entails_bot)
      then show ?thesis
        using approx_a_C unfolding approximates_def
        by (smt (verit) Un_commute Un_empty_right core.C_entails_fml core.fml_ext_is_mapping 
            core.neg_ext_sound_cons_rel.entails_cut)
    qed
  qed
  then have
    core.enabled_set {AF.Pair bot (finsert (neg a) (A_of 𝒞))} J 
       core.fml_ext ` total_strip J  Pos ` ({𝒞} projJ J) ⊨s {Pos bot}
    for J 
    unfolding core.enabled_projection_def core.enabled_def core.enabled_set_def
    by auto 
  then show {𝒞} ⊨sAF {AF.Pair bot (finsert (neg a) (A_of 𝒞))}
    unfolding core.AF_entails_sound_def by auto
qed

lemma extend_infs_with_approx: 
  assumes
    AF_calculus_extended (to_AF bot) core.SInf (⊨AF) (⊨sAF) core.SRedI core.SRedF Simps
      OptInfs
  shows
    AF_calculus_with_approx (to_AF bot) core.SInf (⊨AF) (⊨sAF) core.SRedI core.SRedF Simps 
       OptInfs approximates
  using AF_calculus_with_approx.intro[OF assms] approx_sound
  by (simp add: AF_calculus_with_approx_axioms_def F_of_to_AF)

interpretation splitting_calc_with_approx:
  AF_calculus_with_approx "to_AF bot" core.SInf "(⊨AF)" "(⊨sAF)" core.SRedI core.SRedF "{}" "{}"
    approximates
  using extend_infs_with_approx[OF empty_simps.AF_calculus_extended_axioms] .

end (* context splitting_calculus *)

subsection ‹Combining all simplifications and optional inferences›

text ‹We have augmented the core calculus with each simplification and optional rule separately. We
  now show how to augment the core calculus with all of them in succession.›
context splitting_calculus
begin

interpretation with_A: AF_calculus_with_approx "to_AF bot" core.SInf "(⊨AF)" "(⊨sAF)" core.SRedI
  core.SRedF "{}" "{}" approximates
  using extend_infs_with_approx[OF empty_simps.AF_calculus_extended_axioms] .

interpretation with_AT: AF_calculus_with_tauto "to_AF bot" core.SInf "(⊨AF)" "(⊨sAF)" core.SRedI
  core.SRedF "{}" with_A.OptInfs_with_approx
  using 
    extend_infs_with_tauto[OF with_A.AF_calc_ext.AF_calculus_extended_axioms] .

interpretation with_ATS: AF_calculus_with_strong_unsat "to_AF bot" core.SInf "(⊨AF)" "(⊨sAF)"
  core.SRedI core.SRedF "{}" with_AT.OptInfs_with_tauto
  using extend_infs_with_strong_unsat[OF 
      with_AT.AF_calc_ext.AF_calculus_extended_axioms] .

interpretation with_ATS_T: AF_calculus_with_trim "to_AF bot" core.SInf "(⊨AF)" "(⊨sAF)" core.SRedI
  core.SRedF "{}" with_ATS.OptInfs_with_strong_unsat
  using extend_simps_with_trim[OF
    with_ATS.AF_calc_ext.AF_calculus_extended_axioms] .

interpretation with_ATS_TC: AF_calculus_with_collect "to_AF bot" core.SInf "(⊨AF)" "(⊨sAF)" 
  core.SRedI core.SRedF with_ATS_T.Simps_with_Trim with_ATS.OptInfs_with_strong_unsat
  using extend_simps_with_collect[OF
    with_ATS_T.AF_calc_ext.AF_calculus_extended_axioms] .

interpretation with_all: AF_calculus_with_split "to_AF bot" core.SInf "(⊨AF)" "(⊨sAF)" 
  core.SRedI core.SRedF with_ATS_TC.Simps_with_Collect with_ATS.OptInfs_with_strong_unsat splittable
  using extend_simps_with_split[OF
    with_ATS_TC.AF_calc_ext.AF_calculus_extended_axioms] .

interpretation full_splitting_calculus: AF_calculus_extended "to_AF bot" 
  core.SInf "(⊨AF)" "(⊨sAF)" core.SRedI core.SRedF with_all.Simps_with_Split  
  with_ATS.OptInfs_with_strong_unsat
  using with_all.AF_calc_ext.AF_calculus_extended_axioms .

text ‹Simplifications and optional inferences can be integrated in derivations. This is made obvious
  by the following two lemmas.›

lemma simp_in_derivations: δ  with_all.Simps_with_Split  
  core.S_calculus.derive (  S_from δ) (  S_to δ)
  unfolding core.S_calculus.derive_def
proof 
  fix C
  assume d_in: δ  with_all.Simps_with_Split and
    C    S_from δ - (  S_to δ)
  then have C  S_from δ - S_to δ
    by blast
  then show C  core.SRedF (  S_to δ)
    using with_all.AF_calc_ext.simps_simp[OF d_in] by (meson core.annotated_calculus_axioms
        annotated_calculus.SRedF_of_subset_F in_mono inf_sup_ord(4))
qed

lemma opt_infs_in_derivations: ι  with_ATS.OptInfs_with_strong_unsat  
  core.S_calculus.derive (  set (prems_of ι)) (  set (prems_of ι)  {concl_of ι})
  unfolding core.S_calculus.derive_def
proof 
  fix C
  assume ι  with_ATS.OptInfs_with_strong_unsat and
    C_in: C    set (prems_of ι) - (  set (prems_of ι)  {concl_of ι})
  have   set (prems_of ι) - (  set (prems_of ι)  {concl_of ι}) = {}
    by blast
  then have False using C_in by auto
  then show C  core.SRedF (  set (prems_of ι)  {concl_of ι})
    by auto
qed

end (* context splitting_calculus *)

subsection ‹The BinSplit Simplification Rule›

text ‹For the sake of the Lightweight Avatar calculus, we define the \textsc{BinSplit} 
  simplification rule, and show that it is indeed a sound simplification rule as in the case of the 
  Split rule.›
locale AF_calculus_with_binsplit =
  base_calculus: AF_calculus_extended bot SInf entails entails_sound SRedI
  SRedF Simps OptInfs
  for bot :: ('f, 'v :: countable) AF and
      SInf :: ('f, 'v) AF inference set and
      entails :: ('f, 'v) AF set  ('f, 'v) AF set  bool (infix AF 50) and
      entails_sound :: ('f, 'v) AF set  ('f, 'v) AF set  bool (infix ⊨sAF 50) and
      SRedI :: ('f, 'v) AF set  ('f, 'v) AF inference set and
      SRedF :: ('f, 'v) AF set  ('f, 'v) AF set and
      Simps :: ('f, 'v) AF simplification set and
      OptInfs :: ('f, 'v) AF inference set
  + fixes
      bin_splittable :: ('f, 'v) AF  'f  'f  ('f, 'v) AF fset  bool
    assumes
      binsplit_prem_entails_cons: bin_splittable 𝒞 C1 C2 𝒞s   𝒞'  fset 𝒞s. {𝒞} ⊨sAF {𝒞'} and
      binsplit_simp: bin_splittable 𝒞 C1 C2 𝒞s  𝒞  SRedF (fset 𝒞s)
begin

text ‹
  We use the same naming convention as for the other rules, where
  $X\_pre$ is the condition which must hold for the rule to be applicable, $X\_res$ is its
  resultant and $X\_simp$ is the simplification rule itself.
›

abbreviation bin_split_pre :: ('f, 'v) AF  'f  'f  ('f, 'v) AF fset  bool where
  bin_split_pre 𝒞 C1 C2 𝒞s  bin_splittable 𝒞 C1 C2 𝒞s

abbreviation bin_split_res :: ('f, 'v) AF  ('f, 'v) AF fset  ('f, 'v) AF set where
  bin_split_res 𝒞 𝒞s  fset 𝒞s

abbreviation bin_split_simp :: ('f, 'v) AF  ('f, 'v) AF fset  ('f, 'v) AF simplification where
  bin_split_simp 𝒞 𝒞s  Simplify {𝒞} (bin_split_res 𝒞 𝒞s)

inductive_set Simps_with_BinSplit :: ('f, 'v) AF simplification set where
  binsplit: bin_split_pre 𝒞 C1 C2 𝒞s  bin_split_simp 𝒞 𝒞s  Simps_with_BinSplit 
| other: simp  Simps  simp  Simps_with_BinSplit

(*
lemma no_infinite_simps: ‹finite (S_from ι) ⟹ ι ∈ Simps_with_BinSplit ⟹ finite (S_to ι)›
  using Simps_with_BinSplit.cases base_calculus.no_infinite_simps
  by force
*)

(* Report theorem 14 for Simps extended with BinSplit *)
theorem SInf_with_binsplit_sound_wrt_entails_sound:
  ι  Simps_with_BinSplit   𝒞  S_to ι. S_from ι ⊨sAF {𝒞}
proof -
  assume ι_is_simp_rule: ι  Simps_with_BinSplit
  then show  𝒞  S_to ι. S_from ι ⊨sAF {𝒞}
  proof (intro ballI)
    fix 𝒞
    assume 𝒞_is_consq_of_ι: 𝒞  S_to ι
    show S_from ι ⊨sAF {𝒞}
      using ι_is_simp_rule
    proof (cases rule: Simps_with_BinSplit.cases)
      case (binsplit 𝒞' C1 C2 𝒞s)
      then have 𝒞'  fset 𝒞s. S_from ι ⊨sAF {𝒞'}
        using binsplit_prem_entails_cons by auto
      then show ?thesis
        using 𝒞_is_consq_of_ι binsplit unfolding S_to_def by auto
    next
      case other
      then show ?thesis
        using 𝒞_is_consq_of_ι base_calculus.simps_sound by auto
    qed
  qed
qed

(* Report theorem 19 for BinSplit *)
lemma binsplit_redundant: bin_split_pre 𝒞 C1 C2 𝒞s  𝒞  SRedF (bin_split_res 𝒞 𝒞s)
proof -
  assume pre_cond: bin_split_pre 𝒞 C1 C2 𝒞s
  then show 𝒞  SRedF (bin_split_res 𝒞 𝒞s)
    using binsplit_simp by simp
qed

(* Report theorem 19 for Simps extended with Split *)
lemma simps_with_binsplit_are_simps: 
  ι  Simps_with_BinSplit  (S_from ι - S_to ι)  SRedF (S_to ι)
proof
  fix 𝒞
  assume i_in: ι  Simps_with_BinSplit and
    C_in: 𝒞  S_from ι - S_to ι
  then show 𝒞  SRedF (S_to ι)
  proof (cases rule: Simps_with_BinSplit.cases)
    case (binsplit 𝒞' C1 C2 𝒞s)
    then have 𝒞 = 𝒞' using C_in by auto
    moreover have S_to ι = bin_split_res 𝒞' 𝒞s using binsplit(1) simplification.sel(2) by auto
    ultimately show ?thesis
      using binsplit_redundant[OF binsplit(2)] by presburger
  next
    case other
    then show ?thesis
      using base_calculus.simps_simp C_in by blast
  qed
qed

sublocale AF_calc_ext: AF_calculus_extended bot SInf entails entails_sound 
  SRedI SRedF Simps_with_BinSplit OptInfs
  using simps_with_binsplit_are_simps SInf_with_binsplit_sound_wrt_entails_sound (*no_infinite_simps*)
  base_calculus.infs_sound  by (unfold_locales, auto)

end (* AF_calculus_with_binsplit *)

context splitting_calculus
begin

definition mk_bin_split :: ('f, 'v) AF  'f  'f  ('f, 'v) AF fset where
  split_form (F_of 𝒞) {|C1, C2|}  mk_bin_split 𝒞 C1 C2  
    let a = (SOME a. a  asn (sign.Pos C1))
    in {|AF.Pair C1 (finsert a (A_of 𝒞)), AF.Pair C2 (finsert (neg a) (A_of 𝒞))|} 

definition bin_splittable :: ('f, 'v) AF  'f  'f  ('f, 'v) AF fset  bool where
  bin_splittable 𝒞 C1 C2 𝒞s  split_form (F_of 𝒞) {|C1, C2|}  mk_bin_split 𝒞 C1 C2 = 𝒞s

theorem binsplit_prem_entails_cons: bin_splittable 𝒞 C1 C2 𝒞s   𝒞'  fset 𝒞s. {𝒞} ⊨sAF {𝒞'}
proof (intro ballI)
  fix 𝒞'
  assume C_u_D_splittable: bin_splittable 𝒞 C1 C2 𝒞s and
    𝒞'_in: 𝒞' |∈| 𝒞s
  then have split_fm: split_form (F_of 𝒞) {|C1, C2|} and
    make_split: mk_bin_split 𝒞 C1 C2 = 𝒞s
    unfolding bin_splittable_def by blast+
  have 𝒞'  (let a = SOME a. a  asn (sign.Pos C1)
        in {AF.Pair C1 (finsert a (A_of 𝒞)), AF.Pair C2 (finsert (neg a) (A_of 𝒞))})
    using make_split mk_bin_split_def[OF split_fm] 𝒞'_in by (metis bot_fset.rep_eq fset_simps(2))
  then obtain a where
    a_in_asn_pos_C1: a  asn (sign.Pos C1) and
    𝒞'_is: 𝒞' = AF.Pair C1 (finsert a (A_of 𝒞))  𝒞' = AF.Pair C2 (finsert (neg a) (A_of 𝒞))
    using core.asn_not_empty insert_iff singletonD some_in_eq by metis
  consider (C1) 𝒞' = AF.Pair C1 (finsert a (A_of 𝒞)) 
    | (C2) 𝒞' = AF.Pair C2 (finsert (neg a) (A_of 𝒞))
    using 𝒞'_is by blast
  then show {𝒞} ⊨sAF {𝒞'}
    unfolding core.AF_entails_sound_def core.enabled_set_def core.enabled_def
  proof (cases)
    case C1
    assume Cp_eq: 𝒞' = AF.Pair C1 (finsert a (A_of 𝒞))
    show J. (𝒞{𝒞'}. fset (A_of 𝒞)  total_strip J) 
        core.fml_ext ` total_strip J  Pos ` ({𝒞} projJ J) ⊨s Pos ` F_of ` {𝒞'}
    proof (rule allI, rule impI)
      fix J
      assume 𝒞{𝒞'}. fset (A_of 𝒞)  total_strip J
      then have a  total_strip J
        and fset (A_of 𝒞)  total_strip J
        using Cp_eq by auto
      then have core.fml_ext ` total_strip J  sign.Pos ` ({𝒞} projJ J) ⊨s {sign.Pos C1}
        using a_in_asn_pos_C1 by (smt (verit, best) core.fml_entails_C core.fml_ext_is_mapping 
          core.neg_ext_sound_cons_rel.entails_subsets image_eqI singletonD subsetI sup_ge1)
      then show core.fml_ext ` total_strip J  Pos ` ({𝒞} projJ J) ⊨s Pos ` F_of ` {𝒞'}
        by (simp add: Cp_eq)
    qed
  next
    case C2
    assume  𝒞'_is_C2: 𝒞' = AF.Pair C2 (finsert (neg a) (A_of 𝒞))
    show J. (𝒞{𝒞'}. fset (A_of 𝒞)  total_strip J)  
      core.fml_ext ` total_strip J  sign.Pos ` ({𝒞} projJ J) ⊨s sign.Pos ` F_of ` {𝒞'}
    proof (rule allI, rule impI)
      fix J
      assume 𝒞{𝒞'}. fset (A_of 𝒞)  total_strip J
      then have a_notin: a  total_strip J
        and in_J: fset (A_of 𝒞)  total_strip J
        using 𝒞'_is_C2 by auto
      have {F_of 𝒞} ⊨s fset {|C1, C2|}
        using split_fm unfolding split_form_def by blast
      then have {sign.Neg C1}  {sign.Pos (F_of 𝒞)} ⊨s {sign.Pos C2}
        unfolding core.sound_cons.entails_neg_def by simp
      moreover have neg_fml_a_in: neg (map_sign fml a)  core.fml_ext ` total_strip J
        using a_notin by (smt (z3) core.fml_ext.elims core.fml_ext.simps(1) core.fml_ext.simps(2) 
            core.fml_ext_is_mapping image_iff neg.simps(1) neg.simps(2) neg_in_total_strip)
      ultimately have neg_fml_a_in_entails: 
        {neg (map_sign fml a)}  {sign.Pos (F_of 𝒞)} ⊨s {sign.Pos C2}
        using core.fml_entails_C core.C_entails_fml 
        by (metis a_in_asn_pos_C1 consequence_relation.swap_neg_in_entails_neg 
            core.neg_ext_sound_cons_rel.entails_cut core.sound_cons.consequence_relation_axioms 
            insert_is_Un neg.simps(1) sup_commute)
      have core.fml_ext ` total_strip J  {sign.Pos (F_of 𝒞)} ⊨s {sign.Pos C2}
      proof -
        have f1: "S. neg (map_sign fml a)  S  S  core.fml_ext ` total_strip J"
          using neg_fml_a_in by blast
        have "S s Sa. (s::'f sign)  Sa  Sa  (s  S)"
          by force
        then show ?thesis
          using f1 
          by (metis (no_types) neg_fml_a_in_entails 
              core.neg_ext_sound_cons_rel.entails_subsets insert_is_Un sup_ge1)
      qed
      moreover have {𝒞} projJ J = {(F_of 𝒞)}
        using in_J unfolding core.enabled_projection_def core.enabled_def by blast
      ultimately have core.fml_ext ` total_strip J  sign.Pos ` ({𝒞} projJ J) ⊨s {sign.Pos C2}
        by simp
      then show core.fml_ext ` total_strip J  Pos ` ({𝒞} projJ J) ⊨s Pos ` F_of ` {𝒞'}
        using 𝒞'_is_C2 by auto
    qed   
  qed
qed

theorem binsplit_simp: bin_splittable 𝒞 C1 C2 𝒞s  𝒞  core.SRedF (fset 𝒞s)
proof -
  assume bin_splittable 𝒞 C1 C2 𝒞s
  then have split_fm: split_form (F_of 𝒞) {|C1, C2|} and
    make_split: mk_bin_split 𝒞 C1 C2 = 𝒞s
    unfolding bin_splittable_def by blast+
  have F_entailment: {F_of 𝒞} ⊨s fset {|C1, C2|}
    using split_fm unfolding split_form_def by blast
  have C_D_make_C_u_D_redundant: C'. C' |∈| {|C1, C2|}  F_of 𝒞  RedF {C'}
    by (meson split_fm split_form_def)
  have a_ex:  a  asn (sign.Pos C1). 
      fset 𝒞s = {AF.Pair C1 (finsert a (A_of 𝒞)), AF.Pair C2 (finsert (neg a) (A_of 𝒞))}
    by (metis mk_bin_split_def[OF split_fm] bot_fset.rep_eq core.asn_not_empty finsert.rep_eq
        make_split some_in_eq)
  then obtain a where a_in: a  asn (sign.Pos C1) and 
    𝒞s_is: fset 𝒞s = {AF.Pair C1 (finsert a (A_of 𝒞)), AF.Pair C2 (finsert (neg a) (A_of 𝒞))}
    by blast
  show 𝒞  core.SRedF (fset 𝒞s)
  proof -
    have 𝒥. fset (A_of 𝒞)  total_strip 𝒥  (F_of 𝒞)  RedF ((fset 𝒞s) projJ 𝒥)
    proof (intro allI impI)
      fix 𝒥
      assume A_in_𝒥: fset (A_of 𝒞)  total_strip 𝒥
            then have a_or_neg_a_in_𝒥: a  total_strip 𝒥  neg a  total_strip 𝒥
        by simp
      then have a_or_neg_a_in_𝒥: fset (finsert a (A_of 𝒞))  total_strip 𝒥 
          fset (finsert (neg a) (A_of 𝒞))  total_strip 𝒥
        by (simp add: A_in_𝒥)
      have (fset 𝒞s) projJ 𝒥  {C1, C2}
        using 𝒞s_is core.enabled_projection_def
        by auto
      moreover have (fset 𝒞s) projJ 𝒥  {}
        unfolding core.enabled_projection_def using a_or_neg_a_in_𝒥 𝒞s_is
        by (metis (mono_tags, lifting) AF.sel(2) core.enabled_def empty_iff insertCI mem_Collect_eq) 
      ultimately show (F_of 𝒞)  RedF ((fset 𝒞s) projJ 𝒥)
        using C_D_make_C_u_D_redundant
        by (smt (verit, del_insts) core.Red_F_of_subset all_not_in_conv empty_subsetI
            finsertCI insert_iff insert_subset subsetD)
    qed
    then show ?thesis
      unfolding core.SRedF_def by (smt (verit, ccfv_threshold) AF.collapse UnCI mem_Collect_eq)
  qed
qed

lemma extend_simps_with_binsplit: 
  assumes
    AF_calculus_extended (to_AF bot) core.SInf (⊨AF) (⊨sAF) core.SRedI 
      core.SRedF Simps OptInfs
  shows
    AF_calculus_with_binsplit (to_AF bot) core.SInf (⊨AF) (⊨sAF) core.SRedI core.SRedF Simps 
      OptInfs bin_splittable
proof -
  interpret sound_simps: AF_calculus_extended "to_AF bot" core.SInf "(⊨AF)"
    "(⊨sAF)" core.SRedI core.SRedF Simps OptInfs
    using assms .
  show ?thesis
  proof
    show bin_splittable 𝒞 C1 C2 𝒞s  𝒞'|∈|𝒞s. {𝒞} ⊨sAF {𝒞'} for 𝒞 C1 C2 𝒞s
      using binsplit_prem_entails_cons .
  next
    show bin_splittable 𝒞 C1 C2 𝒞s  𝒞  core.SRedF (fset 𝒞s) for 𝒞 C1 C2 𝒞s
      using binsplit_simp .
  qed
qed

interpretation splitting_calc_with_binsplit: AF_calculus_with_binsplit "to_AF bot" core.SInf "(⊨AF)"
  "(⊨sAF)" core.SRedI core.SRedF "{}" "{}" bin_splittable
  using extend_simps_with_binsplit[OF empty_simps.AF_calculus_extended_axioms]
  .

end (* locale splitting_calculus *)

end