Require Import Logic.GeneralLogic.Base.
Require Import Logic.GeneralLogic.ProofTheory.BasicSequentCalculus.
Require Import Logic.GeneralLogic.ProofTheory.BasicDeduction.
Require Import Logic.GeneralLogic.ProofTheory.BasicLogicEquiv.
Require Import Logic.MinimumLogic.Syntax.
Require Import Logic.MinimumLogic.ProofTheory.Minimum.
Require Import Logic.MinimumLogic.ProofTheory.RewriteClass.
Require Import Logic.MinimumLogic.ProofTheory.TheoryOfJudgement.
Require Import Logic.PropositionalLogic.Syntax.
Require Import Logic.PropositionalLogic.ProofTheory.Intuitionistic.
Require Import Logic.PropositionalLogic.ProofTheory.Classical.
Require Import Logic.PropositionalLogic.ProofTheory.DeMorgan.
Require Import Logic.PropositionalLogic.ProofTheory.GodelDummett.
Require Import Logic.PropositionalLogic.ProofTheory.RewriteClass.
Require Import Logic.PropositionalLogic.ProofTheory.TheoryOfIteratedConnectives.
Require Import Logic.PropositionalLogic.ProofTheory.TheoryOfClassicalAxioms.
Require Import Logic.PropositionalLogic.ProofTheory.TheoryOfPropositionalConnectives.
Require Import Logic.PropositionalLogic.ProofTheory.ProofTheoryPatterns.
Require Import Logic.MetaLogicInj.Syntax.
Require Import Logic.MetaLogicInj.ProofTheory.ProofRules.
Require Import Logic.SeparationLogic.Syntax.
Require Import Logic.SeparationLogic.ProofTheory.Deduction.
Require Import Logic.SeparationLogic.ProofTheory.SeparationLogic.
Require Import Logic.SeparationLogic.ProofTheory.RewriteClass.
Require Import Logic.SeparationLogic.ProofTheory.DerivedRules.
Require Import Logic.SeparationLogic.ProofTheory.IterSepcon.
Require Import Logic.SeparationLogic.ProofTheory.TheoryOfCancel.
Require Import Logic.SeparationLogic.ProofTheory.TheoryOfSeparationAxioms.
Require Import Logic.SeparationLogic.ProofTheory.Corable.

Require Logic.LogicGenerator.ConfigLang.
Require Import Logic.LogicGenerator.Utils.

Module D.
Import ConfigLang.
Import ListNotations.

Definition types: list type :=
  [ expr
  ; context
  ].

Definition connectives: list connective :=
  [ impp
  ; andp
  ; orp
  ; falsep
  ; truep
  ; iffp
  ; negp
  ; coq_prop
  ; sepcon
  ; wand
  ; emp
  ; multi_imp
  ; iter_andp
  ; iter_sepcon
  ; empty_context
  ].

Definition judgements: list judgement :=
  [ provable
  ; derivable
  ; derivable1
  ; logic_equiv
  ; corable
  ].

Definition how_types: list how_type :=
  [ FROM_ensemble_expr_TO_context
  ].

Definition how_connectives: list how_connective :=
  [ FROM_andp_impp_TO_iffp
  ; FROM_falsep_impp_TO_negp
  ; FROM_falsep_impp_TO_truep
  ; FROM_impp_negp_TO_orp
  ; FROM_negp_falsep_TO_truep
  ; FROM_negp_truep_TO_falsep
  ; FROM_impp_TO_multi_imp
  ; FROM_andp_TO_iter_andp
  ; FROM_sepcon_TO_iter_sepcon
  ; FROM_empty_set_TO_empty_context
  ].

Definition how_judgements: list how_judgement :=
  [ FROM_provable_TO_derivable
  ; FROM_derivable_TO_provable
  ; FROM_provable_TO_derivable1
  ; FROM_provable_TO_logic_equiv
  ; FROM_derivable1_TO_logic_equiv
  ].

Definition type_classes :=
  [ Language
  ].

Definition connective_classes :=
  [ MinimumLanguage
  ; AndLanguage
  ; OrLanguage
  ; FalseLanguage
  ; TrueLanguage
  ; IffLanguage
  ; NegLanguage
  ; CoqPropLanguage
  ; SepconLanguage
  ; WandLanguage
  ; EmpLanguage
  ; IterAndLanguage
  ; IterSepconLanguage
  ].

Definition judgement_classes :=
  [ Provable
  ; Derivable
  ; Derivable1
  ; LogicEquiv
  ; Corable
  ].

Definition rule_classes :=
  [ provability_OF_impp
  ; provability_OF_andp
  ; provability_OF_orp
  ; provability_OF_falsep
  ; provability_OF_truep
  ; provability_OF_iffp
  ; provability_OF_negp
  ; provability_OF_iter_andp
  ; provability_OF_de_morgan
  ; provability_OF_godel_dummett
  ; provability_OF_classical_logic
  ; provability_OF_classical_logic_peirce
  ; provability_OF_classical_logic_by_contra
  ; provability_OF_classical_logic_double_negp
  ; provability_OF_classical_logic_canalysis
  ; provability_OF_classical_logic_EM
  ; provability_OF_classical_logic_impp_orp
  ; provability_OF_coq_prop
  ; provability_OF_coq_prop_impp
  ; provability_OF_sepcon_rule
  ; provability_OF_wand_rule
  ; provability_OF_emp_rule
  ; provability_OF_iter_sepcon
  ; provability_OF_sepcon_orp_rule
  ; provability_OF_sepcon_falsep_rule
  ; provability_OF_sepcon_coq_prop
  ; provability_OF_sepcon_rule_AS_weak
  ; provability_OF_sepcon_rule_AS_weak_iffp
  ; provability_OF_sepcon_rule_AS_mono
  ; provability_OF_emp_rule_AS_iffp
  ; provability_OF_garbage_collected_sl
  ; derivitive_OF_basic_setting
  ; derivitive_OF_finite_derivation
  ; derivitive_OF_impp
  ; derivitive_OF_andp
  ; derivitive_OF_orp
  ; derivitive_OF_falsep
  ; derivitive_OF_truep
  ; derivitive_OF_iffp
  ; derivitive_OF_negp
(*  ; derivitive_OF_de_morgan *)
(*  ; derivitive_OF_godel_dummett *)
  ; derivitive_OF_classical_logic
  ; derivitive1_OF_basic_setting
  ; derivitive1_OF_impp_andp_adjoint
  ; derivitive1_OF_andp
  ; derivitive1_OF_orp
  ; derivitive1_OF_falsep
  ; derivitive1_OF_truep
  ; derivitive1_OF_iffp
  ; derivitive1_OF_negp
  ; derivitive1_OF_impp_negp
  ; derivitive1_OF_sepcon
  ; derivitive1_OF_wand
  ; derivitive1_OF_emp
  ; derivitive1_OF_sepcon_orp_rule
  ; derivitive1_OF_sepcon_falsep_rule
  ; equivalence_OF_basic_setting
  ; equivalence_OF_impp
  ; corability_OF_basic_setting
  ; corability_OF_coq_prop
  ; GEN_iffp_FROM_andp_impp
  ; GEN_truep_FROM_falsep_impp
  ; GEN_negp_FROM_falsep_impp
  ; GEN_orp_FROM_impp_negp
  ; GEN_truep_FROM_impp_self
  ; GEN_truep_FROM_negp_falsep
  ; GEN_falsep_FROM_negp_truep
  ; GEN_iter_andp_FROM_fold_left_andp
  ; GEN_iter_andp_FROM_fold_right_andp
  ; GEN_iter_sepcon_FROM_fold_left_sepcon
  ; GEN_iter_sepcon_FROM_fold_right_sepcon
  ; GEN_derivable_FROM_provable
  ; GEN_provable_FROM_derivable
  ; GEN_derivable1_FROM_provable
  ; GEN_logic_equiv_FROM_provable
  ; GEN_logic_equiv_FROM_derivable1
  ].

Definition classes :=
  ltac:(let l := eval compute in
         (map TC type_classes ++
          map CC connective_classes ++
          map JC judgement_classes ++
          map RC rule_classes) in
        exact l).

Definition refl_classes :=
  [ RC GEN_iffp_FROM_andp_impp
  ; RC GEN_truep_FROM_falsep_impp
  ; RC GEN_negp_FROM_falsep_impp
  ; RC GEN_orp_FROM_impp_negp
  ; RC GEN_truep_FROM_negp_falsep
  ; RC GEN_falsep_FROM_negp_truep
  ; RC GEN_iter_andp_FROM_fold_left_andp
  ; RC GEN_iter_sepcon_FROM_fold_left_sepcon
  ; RC GEN_derivable_FROM_provable
  ; RC GEN_provable_FROM_derivable
  ; RC GEN_derivable1_FROM_provable
  ; RC GEN_logic_equiv_FROM_provable
  ; RC GEN_logic_equiv_FROM_derivable1
  ].

End D.

Definition Build_Language := Build_Language.
Definition Build_MinimumLanguage := Build_MinimumLanguage.
Definition Build_AndLanguage := Build_AndLanguage.
Definition Build_OrLanguage := Build_OrLanguage.
Definition Build_FalseLanguage := Build_FalseLanguage.
Definition Build_TrueLanguage := Build_TrueLanguage.
Definition Build_IffLanguage := Build_IffLanguage.
Definition Build_NegLanguage := Build_NegLanguage.
Definition Build_IterAndLanguage := Build_IterAndLanguage.
Definition Build_CoqPropLanguage := Build_CoqPropLanguage.
Definition Build_SepconLanguage := Build_SepconLanguage.
Definition Build_WandLanguage := Build_WandLanguage.
Definition Build_EmpLanguage := Build_EmpLanguage.
Definition Build_IterSepconLanguage := Build_IterSepconLanguage.
Definition Build_Provable := Build_Provable.
Definition Build_Derivable := Build_Derivable.
Definition Build_Derivable1 := Build_Derivable1.
Definition Build_LogicEquiv := Build_LogicEquiv.
Definition Build_Corable := Build_Corable.
Definition Build_IffDefinition_And_Imp := Build_IffDefinition_And_Imp.
Definition Build_TrueDefinition_False_Imp := Build_TrueDefinition_False_Imp.
Definition Build_NegDefinition_False_Imp := Build_NegDefinition_False_Imp.
Definition Build_OrDefinition_Imp_Neg := Build_OrDefinition_Imp_Neg.
Definition Build_TrueDefinition_Imp_Self := Build_TrueDefinition_Imp_Self.
Definition Build_TrueDefinition_Neg_False := Build_TrueDefinition_Neg_False.
Definition Build_FalseDefinition_Neg_True := Build_FalseDefinition_Neg_True.
Definition Build_IterAndDefinition_left := Build_IterAndDefinition_left.
Definition Build_IterAndDefinition_right := Build_IterAndDefinition_right.
Definition Build_IterSepconDefinition_left := Build_IterSepconDefinition_left.
Definition Build_IterSepconDefinition_right := Build_IterSepconDefinition_right.
Definition Build_DerivableProvable := Build_DerivableProvable.
Definition Build_ProvableDerivable := Build_ProvableDerivable.
Definition Build_Derivable1Provable := Build_Derivable1Provable.
Definition Build_EquivProvable := Build_EquivProvable.
Definition Build_EquivDerivable1 := Build_EquivDerivable1.
Definition Build_MinimumAxiomatization := Build_MinimumAxiomatization.
Definition Build_AndAxiomatization := Build_AndAxiomatization.
Definition Build_OrAxiomatization := Build_OrAxiomatization.
Definition Build_FalseAxiomatization := Build_FalseAxiomatization.
Definition Build_TrueAxiomatization := Build_TrueAxiomatization.
Definition Build_IffAxiomatization := Build_IffAxiomatization.
Definition Build_IntuitionisticNegAxiomatization := Build_IntuitionisticNegAxiomatization.
Definition Build_IterAndAxiomatization_left := Build_IterAndAxiomatization_left.
Definition Build_DeMorganAxiomatization := Build_DeMorganAxiomatization.
Definition Build_ClassicalAxiomatization := Build_ClassicalAxiomatization.
Definition Build_PeirceLaw := Build_PeirceLaw.
Definition Build_ByContradiction := Build_ByContradiction.
Definition Build_DoubleNegElimination := Build_DoubleNegElimination.
Definition Build_ClassicAnalysis := Build_ClassicAnalysis.
Definition Build_ExcludedMiddle := Build_ExcludedMiddle.
Definition Build_ImplyToOr := Build_ImplyToOr.
Definition Build_CoqPropAxiomatization := Build_CoqPropAxiomatization.
Definition Build_CoqPropImpAxiomatization := Build_CoqPropImpAxiomatization.
Definition Build_SepconAxiomatization := Build_SepconAxiomatization.
Definition Build_WandAxiomatization := Build_WandAxiomatization.
Definition Build_EmpAxiomatization := Build_EmpAxiomatization.
Definition Build_IterSepconAxiomatization_left := Build_IterSepconAxiomatization_left.
Definition Build_SepconOrAxiomatization := Build_SepconOrAxiomatization.
Definition Build_SepconFalseAxiomatization := Build_SepconFalseAxiomatization.
Definition Build_SepconCoqPropAxiomatization := Build_SepconCoqPropAxiomatization.
Definition Build_SepconAxiomatization_weak := Build_SepconAxiomatization_weak.
Definition Build_SepconAxiomatization_weak_iffp := Build_SepconAxiomatization_weak_iffp.
Definition Build_SepconMonoAxiomatization := Build_SepconMonoAxiomatization.
Definition Build_EmpAxiomatization_iffp := Build_EmpAxiomatization_iffp.
Definition Build_GarbageCollectSeparationLogic := Build_GarbageCollectSeparationLogic.
Definition Build_BasicSequentCalculus := Build_BasicSequentCalculus.
Definition Build_FiniteWitnessedSequentCalculus := Build_FiniteWitnessedSequentCalculus.
Definition Build_MinimumSequentCalculus := Build_MinimumSequentCalculus.
Definition Build_AndSequentCalculus := Build_AndSequentCalculus.
Definition Build_OrSequentCalculus := Build_OrSequentCalculus.
Definition Build_FalseSequentCalculus := Build_FalseSequentCalculus.
Definition Build_TrueSequentCalculus := Build_TrueSequentCalculus.
Definition Build_IffSequentCalculus := Build_IffSequentCalculus.
Definition Build_IntuitionisticNegSequentCalculus := Build_IntuitionisticNegSequentCalculus.
Definition Build_ClassicalSequentCalculus := Build_ClassicalSequentCalculus.
Definition Build_BasicDeduction := Build_BasicDeduction.
Definition Build_AndDeduction := Build_AndDeduction.
Definition Build_ImpAndAdjointDeduction := Build_ImpAndAdjointDeduction.
Definition Build_OrDeduction := Build_OrDeduction.
Definition Build_FalseDeduction := Build_FalseDeduction.
Definition Build_TrueDeduction := Build_TrueDeduction.
Definition Build_IffDeduction := Build_IffDeduction.
Definition Build_IntuitionisticNegDeduction := Build_IntuitionisticNegDeduction.
Definition Build_ImpNegDeduction := Build_ImpNegDeduction.
Definition Build_SepconDeduction := Build_SepconDeduction.
Definition Build_WandDeduction := Build_WandDeduction.
Definition Build_EmpDeduction := Build_EmpDeduction.
Definition Build_SepconOrDeduction := Build_SepconOrDeduction.
Definition Build_SepconFalseDeduction := Build_SepconFalseDeduction.
Definition Build_BasicLogicEquiv := Build_BasicLogicEquiv.
Definition Build_ImpLogicEquiv := Build_ImpLogicEquiv.
Definition Build_Corable_withAxiomatization := Build_Corable_withAxiomatization.
Definition Build_CoqPropCorable := Build_CoqPropCorable.

Module S.
Import NameListNotations.
Section S.

Context {L: Language}
        {minL: MinimumLanguage L}
        {andpL: AndLanguage L}
        {orpL: OrLanguage L}
        {falsepL: FalseLanguage L}
        {truepL: TrueLanguage L}
        {iffpL: IffLanguage L}
        {negpL: NegLanguage L}
        {iter_andp_L : IterAndLanguage L}
        {coq_prop_L : CoqPropLanguage L}
        {sepconL : SepconLanguage L}
        {wandL : WandLanguage L}
        {empL: EmpLanguage L}
        {iter_sepcon_L : IterSepconLanguage L}
        {GammaP: Provable L}
        {GammaD: Derivable L}
        {GammaD1: Derivable1 L}
        {GammaE: LogicEquiv L}
        {Cor: Corable L}
        {iffpDef: IffDefinition_And_Imp L}
        {truepDef: TrueDefinition_False_Imp L}
        {negpDef: NegDefinition_False_Imp L}
        {orpDef_impp_negp: OrDefinition_Imp_Neg L}
        {truepDef_impp_self: TrueDefinition_Imp_Self L}
        {truepDef_negp_falsep: TrueDefinition_Neg_False L}
        {falsepDef_negp_truep: FalseDefinition_Neg_True L}
        {iter_andp_DL: IterAndDefinition_left L}
        {iter_andp_DR: IterAndDefinition_right L}
        {iter_sepcon_DL: IterSepconDefinition_left L}
        {iter_sepcon_DR: IterSepconDefinition_right L}
        {GammaDP: DerivableProvable L GammaP GammaD}
        {GammaPD : ProvableDerivable L GammaP GammaD}
        {GammaD1P: Derivable1Provable L GammaP GammaD1}
        {GammaEP: EquivProvable L GammaP GammaE}
        {GammaED1: EquivDerivable1 L GammaD1 GammaE}
        {minAX: MinimumAxiomatization L GammaP}
        {andpAX: AndAxiomatization L GammaP}
        {orpAX: OrAxiomatization L GammaP}
        {falsepAX: FalseAxiomatization L GammaP}
        {truepAX: TrueAxiomatization L GammaP}
        {iffpAX: IffAxiomatization L GammaP}
        {inegpAX: IntuitionisticNegAxiomatization L GammaP}
        {iter_andp_AXL: IterAndAxiomatization_left L GammaP}
        {cpAX: ClassicalAxiomatization L GammaP}
        {dmpAX: DeMorganAxiomatization L GammaP}
        {gdpAX: GodelDummettAxiomatization L GammaP}
        {plAX: PeirceLaw L GammaP}
        {bcAX: ByContradiction L GammaP}
        {double_negp_elim_AX: DoubleNegElimination L GammaP}
        {caAX: ClassicAnalysis L GammaP}
        {emAX: ExcludedMiddle L GammaP}
        {impp2orpAX: ImplyToOr L GammaP}
        {coq_prop_AX: CoqPropAxiomatization L GammaP}
        {coq_prop_impp_AX: CoqPropImpAxiomatization L GammaP}
        {sepconAX: SepconAxiomatization L GammaP}
        {wandAX: WandAxiomatization L GammaP}
        {empAX: EmpAxiomatization L GammaP}
        {iter_sepcon_AXL: IterSepconAxiomatization_left L GammaP}
        {sepcon_orp_AX: SepconOrAxiomatization L GammaP}
        {sepcon_falsep_AX: SepconFalseAxiomatization L GammaP}
        {sepcon_coq_prop_AX: SepconCoqPropAxiomatization L GammaP}
        {sepconAX_weak: SepconAxiomatization_weak L GammaP}
        {sepconAX_weak_iffp: SepconAxiomatization_weak_iffp L GammaP}
        {sepcon_mono_AX: SepconMonoAxiomatization L GammaP}
        {empAX_iffp: EmpAxiomatization_iffp L GammaP}
        {extsAX: ExtSeparationLogic L GammaP}
        {nsesAX: NonsplitEmpSeparationLogic L GammaP}
        {desAX: DupEmpSeparationLogic L GammaP}
        {mfsAX: MallocFreeSeparationLogic L GammaP}
        {gcsAX: GarbageCollectSeparationLogic L GammaP}
        {bSC : BasicSequentCalculus L GammaD}
        {fwSC : FiniteWitnessedSequentCalculus L GammaD}
        {minSC: MinimumSequentCalculus L GammaD}
        {andpSC : AndSequentCalculus L GammaD}
        {orpSC : OrSequentCalculus L GammaD}
        {falsepSC : FalseSequentCalculus L GammaD}
        {truepSC : TrueSequentCalculus L GammaD}
        {iffpSC : IffSequentCalculus L GammaD}
        {inegpSC : IntuitionisticNegSequentCalculus L GammaD}
        {cpSC : ClassicalSequentCalculus L GammaD}
        {bD : BasicDeduction L GammaD1}
        {adjD: ImpAndAdjointDeduction L GammaD1}
        {andpD : AndDeduction L GammaD1}
        {orpD : OrDeduction L GammaD1}
        {falsepD : FalseDeduction L GammaD1}
        {truepD : TrueDeduction L GammaD1}
        {iffpD : IffDeduction L GammaD1}
        {inegpD : IntuitionisticNegDeduction L GammaD1}
        {impp_negp_D: ImpNegDeduction L GammaD1}
        {sepconD : SepconDeduction L GammaD1}
        {wandD : WandDeduction L GammaD1}
        {empD : EmpDeduction L GammaD1}
        {sepcon_orp_D : SepconOrDeduction L GammaD1}
        {sepcon_falsep_D : SepconFalseDeduction L GammaD1}
        {bE: BasicLogicEquiv L GammaE}
        {imppE: ImpLogicEquiv L GammaE}
        {CorAX: Corable_withAxiomatization L GammaP Cor}
        {coq_prop_Cor: CoqPropCorable L Cor}
        .

Definition types: list Name :=
  [ expr
  ; context
  ].

Definition connectives: list Name :=
  [ impp
  ; andp
  ; orp
  ; falsep
  ; truep
  ; iffp
  ; negp
  ; coq_prop
  ; sepcon
  ; wand
  ; emp
  ; multi_imp
  ; iter_andp
  ; iter_sepcon
  ; empty_context
  ].

Definition judgements: list Name :=
  [ provable
  ; derivable
  ; derivable1
  ; logic_equiv
  ; corable
  ].

Definition how_types: list Name :=
  [ (context, expr -> Prop)
  ].

Definition how_connectives: list Name :=
  [ (iffp, fun x y => andp (impp x y) (impp y x))
  ; (negp, fun x => impp x falsep)
  ; (truep, impp falsep falsep)
  ; (orp, fun x y => impp (negp x) y)
  ; (truep, negp falsep)
  ; (falsep, negp truep)
  ; (multi_imp, fun xs y => fold_right impp y xs)
  ; (iter_andp, fun xs => fold_left andp xs truep)
  ; (iter_sepcon, fun xs => fold_left sepcon xs emp)
  ; (empty_context, Empty_set expr)
  ].

Definition how_judgements: list Name :=
  [ (derivable, fun Phi x => exists xs, Forall Phi xs /\ provable (multi_imp xs x))
  ; (provable, fun x => derivable empty_context x)
  ; (derivable1, fun x y => provable (impp x y))
  ; (logic_equiv, fun x y => provable (impp x y) /\ provable (impp y x))
  ; (logic_equiv, fun x y => derivable1 x y /\ derivable1 y x)
  ].

Definition type_instances_build :=
  [ (L, Build_Language expr)
  ].

Definition connective_instances_build :=
  [ (minL, Build_MinimumLanguage L impp)
  ; (andpL, Build_AndLanguage L andp)
  ; (orpL, Build_OrLanguage L orp)
  ; (falsepL, Build_FalseLanguage L falsep)
  ; (truepL, Build_TrueLanguage L truep)
  ; (iffpL, Build_IffLanguage L iffp)
  ; (negpL, Build_NegLanguage L negp)
  ; (iter_andp_L, Build_IterAndLanguage L iter_andp)
  ; (coq_prop_L, Build_CoqPropLanguage L coq_prop)
  ; (sepconL, Build_SepconLanguage L sepcon)
  ; (wandL, Build_WandLanguage L wand)
  ; (empL, Build_EmpLanguage L emp)
  ; (iter_sepcon_L, Build_IterSepconLanguage L iter_sepcon)
  ].

Definition judgement_instances_build :=
  [ (GammaP, Build_Provable _ provable)
  ; (GammaD, Build_Derivable _ derivable)
  ; (GammaD1, Build_Derivable1 _ derivable1)
  ; (GammaE, Build_LogicEquiv _ logic_equiv)
  ; (Cor, Build_Corable _ corable)
  ].

Definition rule_instances_build :=
  [ (minAX, Build_MinimumAxiomatization L minL GammaP modus_ponens axiom1 axiom2)
  ; (andpAX, Build_AndAxiomatization L minL andpL GammaP andp_intros andp_elim1 andp_elim2)
  ; (orpAX, Build_OrAxiomatization L minL orpL GammaP orp_intros1 orp_intros2 orp_elim)
  ; (falsepAX, Build_FalseAxiomatization L minL falsepL GammaP falsep_elim)
  ; (truepAX, Build_TrueAxiomatization L truepL GammaP truep_intros)
  ; (iffpAX, Build_IffAxiomatization L minL iffpL GammaP iffp_intros iffp_elim1 iffp_elim2)
  ; (inegpAX, Build_IntuitionisticNegAxiomatization L minL negpL GammaP contrapositivePP contradiction_elim1 double_negp_intros)
  ; (iter_andp_AXL, Build_IterAndAxiomatization_left L truepL andpL iffpL iter_andp_L GammaP iter_andp_spec_left)
  ; (dmpAX, Build_DeMorganAxiomatization L minL orpL falsepL negpL GammaP weak_excluded_middle)
  ; (gdpAX, Build_GodelDummettAxiomatization L minL orpL GammaP impp_choice)
  ; (cpAX, Build_ClassicalAxiomatization L minL GammaP peirce_law)
  ; (plAX, Build_PeirceLaw L minL GammaP peirce_law)
  ; (bcAX, Build_ByContradiction L minL negpL GammaP by_contradiction)
  ; (double_negp_elim_AX, Build_DoubleNegElimination L minL negpL GammaP double_negp_elim)
  ; (caAX, Build_ClassicAnalysis L minL negpL GammaP classic_analysis)
  ; (emAX, Build_ExcludedMiddle L orpL negpL GammaP excluded_middle)
  ; (impp2orpAX, Build_ImplyToOr L minL orpL negpL GammaP impp2orp1)
  ; (coq_prop_AX, Build_CoqPropAxiomatization L minL coq_prop_L GammaP coq_prop_intros coq_prop_elim)
  ; (coq_prop_impp_AX, Build_CoqPropImpAxiomatization L minL coq_prop_L GammaP coq_prop_impp)
  ; (sepconAX, Build_SepconAxiomatization L minL sepconL GammaP sepcon_comm_impp sepcon_assoc1 sepcon_mono)
  ; (wandAX, Build_WandAxiomatization L minL sepconL wandL GammaP wand_sepcon_adjoint)
  ; (empAX, Build_EmpAxiomatization L minL sepconL empL GammaP sepcon_emp1 sepcon_emp2)
  ; (iter_sepcon_AXL, Build_IterSepconAxiomatization_left L minL sepconL empL iter_sepcon_L GammaP iter_sepcon_spec_left1 iter_sepcon_spec_left2)
  ; (sepcon_orp_AX, Build_SepconOrAxiomatization L minL orpL sepconL GammaP orp_sepcon_impp)
  ; (sepcon_falsep_AX, Build_SepconFalseAxiomatization L minL falsepL sepconL GammaP falsep_sepcon_impp)
  ; (sepcon_coq_prop_AX, Build_SepconCoqPropAxiomatization L minL andpL iffpL coq_prop_L sepconL GammaP prop_andp_sepcon1)
  ; (sepconAX_weak, Build_SepconAxiomatization_weak L minL sepconL GammaP sepcon_comm_impp sepcon_assoc1)
  ; (sepconAX_weak_iffp, Build_SepconAxiomatization_weak_iffp L iffpL sepconL GammaP sepcon_comm sepcon_assoc)
  ; (sepcon_mono_AX, Build_SepconMonoAxiomatization L minL sepconL GammaP sepcon_mono)
  ; (empAX_iffp, Build_EmpAxiomatization_iffp L iffpL sepconL empL GammaP sepcon_emp)
  ; (gcsAX, Build_GarbageCollectSeparationLogic L minL sepconL GammaP sepcon_elim1)
  ; (bSC, Build_BasicSequentCalculus L GammaD deduction_weaken derivable_assum deduction_subst)
  ; (fwSC, Build_FiniteWitnessedSequentCalculus L GammaD derivable_finite_witnessed)
  ; (minSC, Build_MinimumSequentCalculus L minL GammaD deduction_modus_ponens deduction_impp_intros)
  ; (andpSC, Build_AndSequentCalculus L andpL GammaD deduction_andp_intros deduction_andp_elim1 deduction_andp_elim2)
  ; (orpSC, Build_OrSequentCalculus L orpL GammaD deduction_orp_intros1 deduction_orp_intros2 deduction_orp_elim)
  ; (falsepSC, Build_FalseSequentCalculus L falsepL GammaD deduction_falsep_elim)
  ; (truepSC, Build_TrueSequentCalculus L truepL GammaD deduction_truep_intros)
  ; (iffpSC, Build_IffSequentCalculus L iffpL GammaD deduction_iffp_intros deduction_iffp_elim1 deduction_iffp_elim2)
  ; (inegpSC, Build_IntuitionisticNegSequentCalculus L negpL GammaD deduction_contrapositivePP deduction_contradiction_elim deduction_double_negp_intros)
  ; (cpSC, Build_ClassicalSequentCalculus L orpL negpL GammaD derivable_excluded_middle)
  ; (bD, Build_BasicDeduction L GammaD1 derivable1_refl derivable1_trans)
  ; (adjD, Build_ImpAndAdjointDeduction L minL andpL GammaD1 derivable1_impp_andp_adjoint)
  ; (andpD, Build_AndDeduction L andpL GammaD1 derivable1_andp_intros derivable1_andp_elim1 derivable1_andp_elim2)
  ; (orpD, Build_OrDeduction L orpL GammaD1 derivable1_orp_intros1 derivable1_orp_intros2 derivable1_orp_elim)
  ; (falsepD, Build_FalseDeduction L falsepL GammaD1 derivable1_falsep_elim)
  ; (truepD, Build_TrueDeduction L truepL GammaD1 derivable1_truep_intros)
  ; (iffpD, Build_IffDeduction L minL iffpL GammaD1 derivable1_iffp_intros derivable1_iffp_elim1 derivable1_iffp_elim2)
  ; (inegpD, Build_IntuitionisticNegDeduction L negpL GammaD1 derivable1_contrapositivePP' derivable1_contradiction_elim derivable1_double_negp_intros)
  ; (impp_negp_D, Build_ImpNegDeduction L minL negpL GammaD1 derivable1_contrapositivePP derivable1_contradiction_elim')
  ; (sepconD, Build_SepconDeduction L sepconL GammaD1 derivable1_sepcon_comm derivable1_sepcon_assoc1 derivable1_sepcon_mono)
  ; (wandD, Build_WandDeduction L sepconL wandL GammaD1 derivable1_wand_sepcon_adjoint)
  ; (empD, Build_EmpDeduction L sepconL empL GammaD1 sepcon_emp_left sepcon_emp_right)
  ; (sepcon_orp_D, Build_SepconOrDeduction L orpL sepconL GammaD1 orp_sepcon_left)
  ; (sepcon_falsep_D, Build_SepconFalseDeduction L falsepL sepconL GammaD1 falsep_sepcon_left)
  ; (bE, Build_BasicLogicEquiv L GammaE logic_equiv_refl logic_equiv_symm logic_equiv_trans)
  ; (imppE, Build_ImpLogicEquiv L minL GammaE logic_equiv_impp)
  ; (CorAX, Build_Corable_withAxiomatization L andpL iffpL sepconL GammaP Cor corable_preserved' corable_andp_sepcon1)
  ; (coq_prop_Cor, Build_CoqPropCorable L coq_prop_L Cor corable_coq_prop)
  ; (iffpDef, Build_IffDefinition_And_Imp L minL andpL iffpL andp_impp2iffp)
  ; (truepDef, Build_TrueDefinition_False_Imp L minL falsepL truepL falsep_impp2truep)
  ; (negpDef, Build_NegDefinition_False_Imp L minL falsepL negpL falsep_impp2negp)
  ; (orpDef_impp_negp, Build_OrDefinition_Imp_Neg L minL negpL orpL impp_negp2orp)
  ; (truepDef_impp_self, Build_TrueDefinition_Imp_Self L minL truepL impp_self2truep)
  ; (truepDef_negp_falsep, Build_TrueDefinition_Neg_False L falsepL negpL truepL negp_falsep2truep)
  ; (falsepDef_negp_truep, Build_FalseDefinition_Neg_True L truepL negpL falsepL negp_truep2falsep)
  ; (iter_andp_DL, Build_IterAndDefinition_left L andpL truepL iter_andp_L iter_andp_def_l)
  ; (iter_andp_DR, Build_IterAndDefinition_right L andpL truepL iter_andp_L iter_andp_def_r)
  ; (iter_sepcon_DL, Build_IterSepconDefinition_left L sepconL empL iter_sepcon_L iter_sepcon_def_l)
  ; (iter_sepcon_DR, Build_IterSepconDefinition_right L sepconL empL iter_sepcon_L iter_sepcon_def_r)
  ; (GammaDP, Build_DerivableProvable L minL GammaP GammaD derivable_provable)
  ; (GammaPD, Build_ProvableDerivable L GammaP GammaD provable_derivable)
  ; (GammaD1P, Build_Derivable1Provable L minL GammaP GammaD1 derivable1_provable)
  ; (GammaEP, Build_EquivProvable L minL GammaP GammaE logic_equiv_provable)
  ; (GammaED1, Build_EquivDerivable1 L GammaD1 GammaE logic_equiv_derivable1)
  ].

Definition instances_build :=
  ltac:(let instances_build :=
          eval cbv [type_instances_build
                    connective_instances_build
                    judgement_instances_build
                    rule_instances_build
                    app] in
        (type_instances_build ++
         connective_instances_build ++
         judgement_instances_build ++
         rule_instances_build) in
        exact instances_build).

Definition refl_instances :=
  [ (iffpDef, AndImp2Iff_Normal)
  ; (truepDef, FalseImp2True_Normal)
  ; (negpDef, FalseImp2Neg_Normal)
  ; (orpDef_impp_negp, ImpNeg2Or_Normal)
  ; (truepDef_negp_falsep, NegFalse2True_Normal)
  ; (falsepDef_negp_truep, NegTrue2False_Normal)
  ; (iter_andp_DL, FoldLeftAnd2IterAnd_Normal)
  ; (iter_sepcon_DL, FoldLeftSepcon2IterSepcon_Normal)
  ; (GammaDP, Provable2Derivable_Normal)
  ; (GammaPD, Derivable2Provable_Normal)
  ; (GammaD1P, Provable2Derivable1_Normal)
  ; (GammaEP, Provable2Equiv_Normal)
  ; (GammaED1, Derivable12Equiv_Normal)
  ].

Definition instance_transitions :=
  [ (iffpAX, IffFromDefToAX_And_Imp)
  ; (truepAX, TrueFromDefToAX_False_Imp)
  ; (inegpAX, NegFromDefToAX_False_Imp)
  ; (orpAX, OrFromDefToAX_Imp_Neg)
  ; (truepAX, TrueFromDefToAX_Imp_Self)
  ; (truepAX, TrueFromDefToAX_Neg_False)
  ; (falsepAX, FalseFromDefToAX_Neg_True)
  ; (iter_andp_AXL, IterAndFromDefToAX_L2L)
  ; (iter_sepcon_AXL, IterSepconFromDefToAX_L2L)
  ; (GammaPD, Axiomatization2SequentCalculus_GammaPD)
  ; (bSC, Axiomatization2SequentCalculus_bSC)
  ; (fwSC, Axiomatization2SequentCalculus_fwSC)
  ; (minSC, Axiomatization2SequentCalculus_minSC)
  ; (andpSC, Axiomatization2SequentCalculus_andpSC)
  ; (orpSC, Axiomatization2SequentCalculus_orpSC)
  ; (falsepSC, Axiomatization2SequentCalculus_falsepSC)
  ; (truepSC, Axiomatization2SequentCalculus_truepSC)
  ; (iffpSC, Axiomatization2SequentCalculus_iffpSC)
  ; (inegpSC, Axiomatization2SequentCalculus_inegpSC)
  ; (cpSC, Axiomatization2SequentCalculus_cpSC)
  ; (GammaDP, SequentCalculus2Axiomatization_GammaDP)
  ; (minAX, SequentCalculus2Axiomatization_minAX)
  ; (andpAX, SequentCalculus2Axiomatization_andpAX)
  ; (orpAX, SequentCalculus2Axiomatization_orpAX)
  ; (falsepAX, SequentCalculus2Axiomatization_falsepAX)
  ; (truepAX, SequentCalculus2Axiomatization_truepAX)
  ; (iffpAX, SequentCalculus2Axiomatization_iffpAX)
  ; (inegpAX, SequentCalculus2Axiomatization_inegpAX)
  ; (cpAX, Peirce2cpAX)
  ; (bcAX, Peirce2ByContradiction)
  ; (double_negp_elim_AX, ByContradiction2DoubleNegElimination)
  ; (caAX, DoubleNegElimination2ClassicAnalysis)
  ; (plAX, ClassicAnalysis2PeirceLaw)
  ; (impp2orpAX, ClassicAnalysis2ImplyToOr)
  ; (emAX, ImplyToOr2ExcludedMiddle)
  ; (caAX, ExcludedMiddle2ClassicAnalysis)
  ; (inegpAX, ByContradiction2IntuitionisticNegAxiomatization)
  ; (sepconAX, SepconAxiomatizationWeak2SepconAxiomatization)
  ; (sepconAX_weak, SepconAxiomatizationWeakIff2SepconAxiomatizationWeak)
  ; (sepcon_mono_AX, Adj2SepconMono)
  ; (sepcon_orp_AX, Adj2SepconOr)
  ; (sepcon_falsep_AX, Adj2SepconFalse)
  ; (empAX, EmpAxiomatizationIff2EmpAxiomatization)
  ; (sepcon_coq_prop_AX, CoqPropCorable2SepconCoqPropAX)
  ; (sepcon_coq_prop_AX, Adj2SepconCoqProp)
  ; (bD, Axiomatization2Deduction_bD)
  ; (sepconD, Axiomatization2Deduction_sepconD)
  ; (wandD, Axiomatization2Deduction_wandD)
  ; (empD, Axiomatization2Deduction_empD)
  ; (bE, Axiomatization2Equiv_bE)
  ; (GammaED1, Axiomatization2Deduction_GammaED1)
  ; (imppE, Axiomatization2LogicEquiv_imppE)
  ].

Definition type_instances: list Name :=
  map_fst type_instances_build.

Definition connective_instances :=
  map_fst connective_instances_build.

Definition judgement_instances :=
  map_fst judgement_instances_build.

Definition rule_instances :=
  map_fst rule_instances_build.

Definition instances :=
  ltac:(let instances :=
          eval cbv [type_instances
                    connective_instances
                    judgement_instances
                    rule_instances
                    app] in
        (type_instances ++
         connective_instances ++
         judgement_instances ++
         rule_instances) in
        exact instances).

Definition type_dependency_via_ins :=
  noninstance_arg_lists
    (type_instances_build, map_snd type_instances_build).

Definition connective_dependency_via_ins :=
  noninstance_arg_lists
    (connective_instances_build, map_snd connective_instances_build).

Definition judgement_dependency_via_ins :=
  noninstance_arg_lists
    (judgement_instances_build, map_snd judgement_instances_build).

Definition primary_rule_dependency_via_ins :=
  noninstance_arg_lists
    (rule_instances_build, map_snd rule_instances_build).

Definition instance_dependency_via_transition :=
  instance_arg_lists
    (instance_transitions, map_snd instance_transitions).

Definition D_type_dependency_via_ins :=
  (map_with_hint (type_instances_build, D.type_classes)
                 (map_fst type_dependency_via_ins),
   map_with_hint (types, D.types)
                 (map_snd type_dependency_via_ins)).

Definition D_connective_dependency_via_ins :=
  (map_with_hint (connective_instances_build, D.connective_classes)
                 (map_fst connective_dependency_via_ins),
   map_with_hint (connectives, D.connectives)
                 (map_snd connective_dependency_via_ins)).

Definition D_judgement_dependency_via_ins :=
  (map_with_hint (judgement_instances_build, D.judgement_classes)
                 (map_fst judgement_dependency_via_ins),
   map_with_hint (judgements, D.judgements)
                 (map_snd judgement_dependency_via_ins)).

Definition D_instance_transitions: list ConfigLang.how_instance :=
  nat_ident_list instance_transitions.

Definition D_instance_transition_results :=
  map_with_hint (instances, D.classes) (map_fst instance_transitions).

Definition D_instance_dependency_via_transition :=
  (map_with_hint (instance_transitions, D_instance_transitions)
                 (map_fst instance_dependency_via_transition),
   map_with_hint (instances, D.classes)
                 (map_snd instance_dependency_via_transition)).

Definition primary_rules_with_dup: list Name :=
  map_snd primary_rule_dependency_via_ins.

Definition derived_rules :=
  [ (* provable * impp *)
    provable_impp_refl
  ; provable_impp_refl'
  ; provable_impp_arg_switch
  ; provable_impp_trans
    (* provable * multi_imp *)
  ; provable_multi_imp_shrink
  ; provable_multi_imp_arg_switch1
  ; provable_multi_imp_arg_switch2
  ; provable_add_multi_imp_left_head
  ; provable_add_multi_imp_left_tail
  ; provable_multi_imp_modus_ponens
  ; provable_multi_imp_weaken
  ; provable_impp_refl_instance
    (* derivable * impp *)
  ; deduction_impp_elim
  ; deduction_theorem
  ; deduction_theorem_multi_imp
  ; derivable_impp_refl
  ; deduction_left_impp_intros
  ; derivable_modus_ponens
  ; deduction_impp_trans
  ; deduction_impp_arg_switch
    (* rewrite classes OF impp *)
  ; provable_proper_impp
  ; impp_proper_impp
  ; derivable_proper_impp

  ; negp_fold_unfold
  ; deduction_negp_fold
  ; deduction_negp_unfold

  ; demorgan_orp_negp
  ; demorgan_negp_orp
  ; provable_truep
  ; andp_comm
  ; andp_assoc
  ; orp_comm
  ; orp_assoc
  ; andp_dup
  ; orp_dup
  ; impp_curry
  ; impp_uncurry
  ; solve_impp_trans
  ; solve_andp_intros
  ; solve_andp_elim1
  ; solve_andp_elim2
  ; negp_fold
  ; negp_unfold
  ; double_negp
  ; contrapositiveNN
  ; contrapositiveNP
  ; impp2orp
  ; solve_weak_classic
  ; solve_classic
  ; andp_proper_impp
  ; orp_proper_impp
  ; negp_proper_impp
  ; provable_iffp_equiv
  ; provable_proper_iffp
  ; impp_proper_iffp
  ; andp_proper_iffp
  ; orp_proper_iffp
  ; iffp_proper_iffp
  ; negp_proper_iffp
  ; derivable_proper_iffp
  ; iter_andp_spec_right
  ; iter_andp_unfold_left_assoc
  ; iter_andp_unfold_right_assoc

  ; coq_prop_truep
  ; coq_prop_andp
  ; andp_coq_prop
  ; coq_prop_andp_impp
  ; andp_coq_prop_impp
  ; impp_coq_prop
  ; coq_prop_and
  ; coq_prop_or
  ; coq_prop_impl

  ; sepcon_orp_distr_l
  ; falsep_sepcon
  ; provable_wand_sepcon_modus_ponens1
  ; wand_andp
  ; sepcon_orp_distr_r
  ; sepcon_falsep
  ; provable_wand_sepcon_modus_ponens2
  ; wand_mono
  ; orp_wand
  ; prop_sepcon_andp2
  ; prop_sepcon_andp1
  ; prop_andp_sepcon2
  ; sepcon_iter_sepcon
  ; cancel_ready
  ; cancel_one_succeed
  ; cancel_one_giveup
  ; cancel_rev
  ; cancel_finish
  ; iter_sepcon_unfold_right_assoc
  ; iter_sepcon_unfold_left_assoc
  ; corable_sepcon_andp2
  ; corable_sepcon_andp1
  ; corable_andp_sepcon2
  ; sepcon_proper_impp
  ; wand_proper_impp
  ; sepcon_proper_iffp
  ; wand_proper_iffp

  ; expr_deep
  ; impp_deep
  ; sepcon_deep
  ; emp_deep
  ; varp_deep
  ; var_pos
  ; sepcon_pos
  ; cancel_mark
  ; cancel_different
  ; cancel_same
  ; restore
  ; cancel_sound

  ; impp_proper_equiv
  ; sepcon_proper_logic_equiv
  ; provable_proper_equiv
  ; logic_equiv_refl_instance
  ; logic_equiv_symm_instance
  ; logic_equiv_trans_instance

  ; sepcon_comm_logic_equiv
  ; sepcon_assoc_logic_equiv
  ; sepcon_emp_logic_equiv

(*
  ; derivable1_sepcon_assoc2
  ; orp_sepcon_right
  ; falsep_sepcon_right
(*  ; sepcon_comm_equiv
  ; sepcon_orp_distr_r_equiv
  ; sepcon_orp_distr_l_equiv
  ; falsep_sepcon_equiv
  ; sepcon_falsep_equiv*)
  ; derivable1_wand_sepcon_modus_ponens1
  ; derivable1_wand_sepcon_modus_ponens2
  ; derivable1_wand_mono
(*  ; wand_andp_equiv
  ; orp_wand_equiv*)
*)
  ].

Ltac filter_instance_rec l res :=
  match l with
  | nil => res
  | cons (BuildName ?x) ?l0 =>
      let tac1 TT := filter_instance_rec l0 (cons (BuildName x) res) in
      let tac2 TT := filter_instance_rec l0 res in
      if_instance x tac1 tac2
  end.

Notation "'filter_instance' l" :=
  (ltac:(let l' := eval hnf in l in
         let res := filter_instance_rec l' (@nil Name) in
         exact res))
  (only parsing, at level 99).

Definition derived_rules_as_instance :=
  filter_instance derived_rules.

Definition D_primary_rules_with_dup: list nat :=
  nodup_nat_ident_list primary_rules_with_dup.

Definition D_primary_rules: list nat :=
  ltac:(
    let l := eval compute in
      (ConfigLang.NatList.shrink D_primary_rules_with_dup)
    in
    exact l).

Definition primary_rules :=
  map_with_hint (D_primary_rules_with_dup, primary_rules_with_dup) D_primary_rules.

Definition D_derived_rules :=
  nat_ident_list derived_rules.

Definition D_derived_rules_as_instance :=
  map_with_hint (derived_rules, D_derived_rules) derived_rules_as_instance.

Definition D_primary_rule_dependency_via_ins :=
  (map_with_hint (rule_instances_build, D.rule_classes)
                 (map_fst primary_rule_dependency_via_ins),
   map_with_hint (primary_rules, D_primary_rules)
                 (map_snd primary_rule_dependency_via_ins)).

(* TODO: delete it *)
Definition primary_rules_dependency_via_ins :=
  instance_arg_lists
    (primary_rules, primary_rules).

Definition derived_rules_dependency_via_ins :=
  instance_arg_lists
    (derived_rules, derived_rules).

(* TODO: delete it *)
Definition D_primary_rules_dependency_via_ins :=
  (map_with_hint (primary_rules, D_primary_rules)
                 (map_fst primary_rules_dependency_via_ins),
   map_with_hint (instances, D.classes)
                 (map_snd primary_rules_dependency_via_ins)).

Definition D_derived_rules_dependency_via_ins :=
  (map_with_hint (derived_rules, D_derived_rules)
                 (map_fst derived_rules_dependency_via_ins),
   map_with_hint (instances, D.classes)
                 (map_snd derived_rules_dependency_via_ins)).

End S.
End S.


Set Implicit Arguments.
Unset Standard Proposition Elimination Names.

Require Import List.
Require Import list_utils.
Require Import Bool.
Require Import expec.
Require Import util.
Require Import sums_and_averages.
Require Import Rbase.

Arguments length {A}.

Section contents.

  Variables (X: Set) (eq_X_dec: forall (x y: X), { x = y } + { x <> y }).
  Definition beq_X (x y: X): bool := unsum_bool (eq_X_dec x y).

  Lemma counts_0_length_0 (l: list X): (forall i, count (beq_X i) l = 0%nat) -> length l = 0%nat.
  Proof with auto.
    destruct l; simpl...
    intros.
    elimtype False.
    specialize (H x).
    unfold beq_X in H.
    destruct (eq_X_dec x x)...
    simpl in H.
    discriminate.
  Qed.

  Lemma counts_0_expec_length_0 t:
    (forall i, expec (count (beq_X i)) t = 0) -> expec (@length (_:Set)) t = 0.
  Proof with auto.
    intros.
    replace 0 with (INR 0)...
    apply expec_constant.
    intros.
    apply counts_0_length_0.
    intros.
    apply (expec_0_inv (count (beq_X i))) with t...
  Qed.

  Lemma exp_list_sum_le (fr: X -> R) (q: list X) (t: ne_tree.T (list X)):
    (forall i, In i q -> expec (count (beq_X i)) t <= fr i) ->
    (forall i, ~ In i q -> expec (count (beq_X i)) t = 0) ->
    expec (@length (_:Set)) t <= Rsum (map fr q).
  Proof with auto with real.
    induction q in t |- *.
      simpl.
      intros.
      rewrite counts_0_expec_length_0...
    simpl.
    intros.
    rewrite (@expec_ext _ (@length (_:Set)) (fun x => plus (count (beq_X a) x) (count (negb ∘ beq_X a) x)) ).
      Focus 2.
      intro.
      apply length_excl_counts.
    rewrite expec_plus.
    apply Rle_trans with (fr a + expec (count (fun t0: X => negb (beq_X a t0))) t)...
    apply Rplus_le_compat_l.
    apply Rle_trans with (expec (@length (_:Set)) (ne_tree.map (filter (fun x: X => negb (beq_X a x))) t)).
      rewrite expec_map.
      apply expec_le.
      intros.
      rewrite comp_apply.
      rewrite length_filter...
    apply IHq...
      intros.
      rewrite expec_map.
      destruct (eq_X_dec a i).
        subst.
        apply Rle_trans with (expec (count (beq_X i)) t)...
        apply expec_le.
        intros.
        repeat rewrite comp_apply.
        apply count_filter_le.
      apply Rle_trans with (expec (count (beq_X i)) t).
        apply expec_le.
        intros.
        repeat rewrite comp_apply.
        apply count_filter_le.
      apply H.
      right...
    intros.
    rewrite expec_map.
    destruct (eq_X_dec a i).
      subst.
      replace 0 with (INR 0)...
      apply expec_constant.
      intros.
      rewrite comp_apply.
      apply count_filtered.
      intros.
      destruct (beq_X i x0)...
    apply Rle_antisym.
      apply Rle_trans with (expec (count (beq_X i)) t).
        apply expec_le.
        intros.
        rewrite comp_apply.
        apply count_filter_le.
      rewrite H0...
      intro.
      destruct H2...
    apply expec_nonneg.
  Qed.

End contents.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable cut_ : Universe -> Universe -> Universe -> Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.
Variable betS_ : Universe -> Universe -> Universe -> Prop.

Variable defcut_1 : (forall A B C D E : Universe, (cut_ A B C D E -> (betS_ A E B /\ (betS_ C E D /\ (~(col_ A B C) /\ ~(col_ A B D)))))).
Variable defcut2_2 : (forall A B C D E : Universe, ((betS_ A E B /\ (betS_ C E D /\ (~(col_ A B C) /\ ~(col_ A B D)))) -> cut_ A B C D E)).
Variable defcollinear_3 : (forall A B C : Universe, (col_ A B C -> (A = B \/ (A = C \/ (B = C \/ (betS_ B A C \/ (betS_ A B C \/ betS_ A C B))))))).
Variable defcollinear2a_4 : (forall A B C : Universe, (A = B -> col_ A B C)).
Variable defcollinear2b_5 : (forall A B C : Universe, (A = C -> col_ A B C)).
Variable defcollinear2c_6 : (forall A B C : Universe, (B = C -> col_ A B C)).
Variable defcollinear2d_7 : (forall A B C : Universe, (betS_ B A C -> col_ A B C)).
Variable defcollinear2e_8 : (forall A B C : Universe, (betS_ A B C -> col_ A B C)).
Variable defcollinear2f_9 : (forall A B C : Universe, (betS_ A C B -> col_ A B C)).
Variable lemma_collinearorder_10 : (forall A B C : Universe, (col_ A B C -> (col_ B A C /\ (col_ B C A /\ (col_ C A B /\ (col_ A C B /\ col_ C B A)))))).
Variable lemma_betweennotequal_11 : (forall A B C : Universe, (betS_ A B C -> (B <> C /\ (A <> B /\ A <> C)))).
Variable lemma_collinear4_12 : (forall A B C D : Universe, ((col_ A B C /\ (col_ A B D /\ A <> B)) -> col_ B C D)).
Variable lemma_collinear1_13 : (forall A B C : Universe, (col_ A B C -> col_ B A C)).
Variable axiom_betweennesssymmetry_14 : (forall A B C : Universe, (betS_ A B C -> betS_ C B A)).

Theorem lemma_twolines_15 : (forall A B C D E F : Universe, ((cut_ A B C D E /\ (cut_ A B C D F /\ ~(col_ B C D))) -> E = F)).
Proof.
  time tac.
Qed.

End FOFProblem.


From Hammer Require Import Hammer.

Require Import Omega.
From hahn Require Import HahnBase HahnList HahnRelationsBasic.
From hahn Require Import HahnEquational HahnMaxElt HahnRewrite.
From hahn Require Import HahnDom HahnMinPath.

Set Implicit Arguments.

Lemma wf_finite :
forall A (r: relation A) (ACYC: acyclic r) l (DOMA : doma r (fun x => List.In x l)),
well_founded r.
Proof. hammer_hook "HahnPath" "HahnPath.wf_finite".
unfold acyclic; ins.
rewrite ct_step; red; ins; apply ct_doma in DOMA; revert DOMA.
generalize (transitive_ct (r:=r)) as T; revert ACYC.
generalize r⁺; clear r; intro r.
remember (length l) as n.
revert r l Heqn.
induction n.
by destruct l; ins; econs; ins; exfalso; eauto.
econs; intros b Rba.
assert (IN:=DOMA _ _ Rba); apply in_split in IN; desf.
rewrite app_length in *; ins.
forward apply (IHn (restr_rel (fun x => x <> b) r) (l1 ++ l2));
eauto using irreflexive_restr, transitive_restr.
by rewrite app_length in *; ins; omega.
by unfold restr_rel; red; ins; desf; eapply DOMA in REL; rewrite <- Permutation_middle in *; ins; desf; eauto.

clear - Rba ACYC T; unfold restr_rel.
econs; ins.
destruct H; specialize (H y); specialize_full H; splits; try intro; desf; eauto.
clear Rba.
by induction H; econs; ins; eapply H1; splits; try intro; desf; eauto.
Qed.

Lemma rt_unionE A (r r' : relation A) : (r ∪ r')＊ ≡ r'＊ ⨾ (r ⨾ r'＊)＊.
Proof. hammer_hook "HahnPath" "HahnPath.rt_unionE".
split; eauto 8 using inclusion_seq_rt, inclusion_rt_rt2 with hahn.
apply inclusion_rt_ind_left; relsf; unionL; rels.
rewrite <- seqA; rels; rewrite rtE at 2; relsf.
Qed.

Lemma ct_unionE A (r r' : relation A) : (r ∪ r')⁺ ≡ r'⁺ ∪ r'＊ ⨾ (r ⨾ r'＊)⁺.
Proof. hammer_hook "HahnPath" "HahnPath.ct_unionE".
rewrite ct_begin, rt_unionE; relsf; rewrite <- seqA; rels.
split; unionL; eauto using inclusion_seq_r, inclusion_seq_l with hahn.
by rewrite rtE; relsf; unionL; eauto with hahn.
by rewrite rtE at 1; relsf; unionL; eauto with hahn.
Qed.

Lemma ct_union_singl A (r : relation A) a b :
(r ∪ singl_rel a b)⁺ ≡ r⁺ ∪ r＊ ⨾ singl_rel a b ⨾ r＊.
Proof. hammer_hook "HahnPath" "HahnPath.ct_union_singl".
split.
{ unfold inclusion, union, singl_rel, seq.
induction 1; desf; eauto 9 using clos_trans, clos_refl_trans, clos_trans_in_rt.
}
eapply inclusion_union_l; eauto with hahn.
rewrite <- rt_ct, ct_begin; eauto with hahn.
Qed.

Lemma rt_union_singl A (r : relation A) a b :
(r ∪ singl_rel a b)＊ ≡ r＊ ∪ r＊ ⨾ singl_rel a b ⨾ r＊.
Proof. hammer_hook "HahnPath" "HahnPath.rt_union_singl".
by rewrite rtE, rtE at 1; rewrite ct_union_singl, !unionA.
Qed.

Lemma ct_union_singl_max A (r : relation A) a b (MAX: max_elt r b) :
(r ∪ singl_rel a b)⁺ ≡ r⁺ ∪ r＊ ⨾ singl_rel a b.
Proof. hammer_hook "HahnPath" "HahnPath.ct_union_singl_max".
rewrite ct_union_singl, seq_singl_max_rt; ins.
Qed.

Lemma rt_union_singl_max A (r : relation A) a b (MAX: max_elt r b) :
(r ∪ singl_rel a b)＊ ≡ r＊ ⨾ (singl_rel a b) ^?.
Proof. hammer_hook "HahnPath" "HahnPath.rt_union_singl_max".
rewrite rt_union_singl, crE, seq_singl_max_rt; relsf.
Qed.

Section PathUnionTotal.

Variable A : Type.
Implicit Type r : relation A.

Lemma path_decomp_u_total r dom r' (T: is_total dom r') (DB: domb r' dom)
(IRR: irreflexive (r＊ ⨾ r'⁺)) :
(r ∪ r')⁺ ≡ r⁺ ∪ r＊ ⨾ r'⁺ ⨾ r＊.
Proof. hammer_hook "HahnPath" "HahnPath.path_decomp_u_total".
split; ins.
{ intros ? ? C; unfold seq, union in *.
induction C; desf; eauto 8 using rt_refl, clos_trans;
eauto 8 using clos_trans_in_rt, rt_trans.

destruct (classic (z1 = z3)) as [|NEQ]; desf;
eauto 6 using t_trans, rt_trans.
eapply T in NEQ; desf.
by exfalso; eauto 10 using clos_trans, rt_trans.
by eauto 8 using clos_trans, rt_trans.
by eapply t_rt_step in IHC0; desf; eauto.
by eapply t_rt_step in IHC4; desf; eauto.
}
eapply inclusion_union_l; eauto with hahn.
rewrite <- rt_ct with (r := r ∪ r'),
<- ct_rt with (r := r ∪ r'); eauto 8 with hahn.
Qed.

End PathUnionTotal.

Section PathAbsorb.

Variable A : Type.
Implicit Type r : relation A.

Lemma path_absorb1 r r' (F: r' ⨾ r ⊆ r') :
(r ∪ r')⁺ ≡ r⁺ ∪ r'⁺ ∪ r⁺ ⨾ r'⁺.
Proof. hammer_hook "HahnPath" "HahnPath.path_absorb1".
split; cycle 1.
repeat apply inclusion_union_l; eauto with hahn.
by repeat apply inclusion_seq_trans; eauto with hahn; vauto.
apply inclusion_t_ind_right; relsf;
repeat apply inclusion_union_l;
eauto 10 using inclusion_t_r_t with hahn;
try solve [rewrite (ct_end r'), !seqA, F, <- ct_end; eauto 10 with hahn].
rewrite (ct_end r') at 3; rewrite seqA; eauto 10 with hahn.
Qed.

Lemma path_absorb2 r r' (F: r' ⨾ r ⊆ r) :
(r ∪ r')⁺ ≡ r⁺ ∪ r'⁺ ∪ r⁺ ⨾ r'⁺.
Proof. hammer_hook "HahnPath" "HahnPath.path_absorb2".
split; cycle 1.
repeat apply inclusion_union_l; eauto with hahn.
by repeat apply inclusion_seq_trans; eauto with hahn; vauto.
apply inclusion_t_ind_left; relsf;
repeat apply inclusion_union_l;
eauto 10 using inclusion_r_t_t with hahn;
try solve [rewrite (ct_begin r), <- !seqA, F, <- ct_begin; eauto 10 with hahn].
rewrite (ct_begin r) at 3; rewrite seqA; eauto 10 with hahn.
Qed.

Lemma path_absorb r r' (F: r' ⨾ r ⊆ r \/ r' ⨾ r ⊆ r') :
(r ∪ r')⁺ ≡ r⁺ ∪ r'⁺ ∪ r⁺ ⨾ r'⁺.
Proof. hammer_hook "HahnPath" "HahnPath.path_absorb".
ins; desf; eauto using path_absorb1, path_absorb2.
Qed.

Lemma path_absorb_lt r r' (F: r' ⨾ r ⊆ r \/ r' ⨾ r ⊆ r') (T: transitive r) :
(r ∪ r')⁺ ≡ r'⁺ ∪ r ⨾ r'＊.
Proof. hammer_hook "HahnPath" "HahnPath.path_absorb_lt".
ins; rewrite path_absorb, rtE; relsf; hahn_rel.
Qed.

Lemma path_absorb_rt r r' (F: r'⨾ r ⊆ r \/ r'⨾ r ⊆ r') (T: transitive r') :
(r ∪ r')⁺ ≡ r⁺ ∪ r＊ ⨾ r'.
Proof. hammer_hook "HahnPath" "HahnPath.path_absorb_rt".
ins; rewrite path_absorb, rtE; relsf; hahn_rel.
Qed.

Lemma minus_seq_l r r' (T: transitive r) :
(r ⨾ r') \ r ⊆ r ⨾ (r' \ r).
Proof. hammer_hook "HahnPath" "HahnPath.minus_seq_l".
unfold minus_rel, seq; red; ins; desf; repeat eexists; eauto.
Qed.

Lemma minus_seq_r r r' (T: transitive r') :
(r ⨾ r') \ r' ⊆ (r \ r') ⨾ r'.
Proof. hammer_hook "HahnPath" "HahnPath.minus_seq_r".
unfold minus_rel, seq; red; ins; desf; repeat eexists; eauto.
Qed.

Lemma seq_rt_absorb_l r r' : r ⨾ r'＊ ⊆ r ∪ ((r ⨾ r') \ r) ⨾ r'＊.
Proof. hammer_hook "HahnPath" "HahnPath.seq_rt_absorb_l".
unfold seq, union, inclusion, minus_rel; ins; desf.
induction H0 using clos_refl_trans_ind_left; desf; eauto.
destruct (classic (r x z0)); eauto 8 using clos_refl_trans.
right; repeat eexists; eauto using clos_refl_trans.
Qed.

Lemma seq_ct_absorb_l r r' : r ⨾ r'⁺ ⊆ r ∪ ((r ⨾ r') \ r) ⨾ r'＊.
Proof. hammer_hook "HahnPath" "HahnPath.seq_ct_absorb_l".
rewrite <- seq_rt_absorb_l; eauto with hahn.
Qed.

Lemma seq_rt_absorb_r r r' : r＊ ⨾ r' ⊆ r' ∪ r＊ ⨾ ((r ⨾ r') \ r').
Proof. hammer_hook "HahnPath" "HahnPath.seq_rt_absorb_r".
apply inclusion_transpE.
rewrite !transp_union, !transp_seq, !transp_minus, !transp_rt, !transp_seq;
auto using seq_rt_absorb_l, transitive_transp.
Qed.

Lemma seq_ct_absorb_r r r' : r⁺ ⨾ r' ⊆ r' ∪ r＊ ⨾ ((r ⨾ r') \ r').
Proof. hammer_hook "HahnPath" "HahnPath.seq_ct_absorb_r".
rewrite <- seq_rt_absorb_r; eauto with hahn.
Qed.

Lemma seq_rt_absorb_lt r r' (T: transitive r) :
r ⨾ r'＊ ⊆ r ∪ r ⨾ (r' \ r) ⨾ r'＊.
Proof. hammer_hook "HahnPath" "HahnPath.seq_rt_absorb_lt".
by rewrite seq_rt_absorb_l, minus_seq_l, seqA.
Qed.

Lemma seq_ct_absorb_lt r r' (T: transitive r) :
r ⨾ r'⁺ ⊆ r ∪ r ⨾ (r' \ r) ⨾ r'＊.
Proof. hammer_hook "HahnPath" "HahnPath.seq_ct_absorb_lt".
by rewrite seq_ct_absorb_l, minus_seq_l, seqA.
Qed.

Lemma seq_rt_absorb_rt r r' (T: transitive r') :
r＊ ⨾ r' ⊆ r' ∪ r＊ ⨾ (r \ r') ⨾ r'.
Proof. hammer_hook "HahnPath" "HahnPath.seq_rt_absorb_rt".
by rewrite seq_rt_absorb_r, minus_seq_r.
Qed.

Lemma seq_ct_absorb_rt r r' (T: transitive r') :
r⁺ ⨾ r' ⊆ r' ∪ r＊ ⨾ (r \ r') ⨾ r'.
Proof. hammer_hook "HahnPath" "HahnPath.seq_ct_absorb_rt".
by rewrite seq_ct_absorb_r, minus_seq_r.
Qed.
End PathAbsorb.

Lemma clos_trans_restr_trans_mid :
forall X (r r' : relation X) f x y
(A : (restr_rel f (r ∪ r'))⁺ x y)
z (B : r y z) w
(C : (restr_rel f (r ∪ r'))⁺ z w),
(restr_rel f (r ∪ r'))⁺ x w.
Proof. hammer_hook "HahnPath" "HahnPath.clos_trans_restr_trans_mid".
ins; eapply t_trans, t_trans; vauto.
eapply t_step; repeat split; vauto.
by apply clos_trans_restrD in A; desc.
by apply clos_trans_restrD in C; desc.
Qed.

Lemma clos_trans_restr_trans_cycle :
forall X (r r' : relation X) f x y
(A : clos_trans (restr_rel f (r ∪ r')) x y)
(B : r y x),
clos_trans (restr_rel f (r ∪ r')) x x.
Proof. hammer_hook "HahnPath" "HahnPath.clos_trans_restr_trans_cycle".
ins; eapply t_trans, t_step; unfold union; eauto.
red; apply clos_trans_restrD in A; desf; auto.
Qed.

Section PathDom.

Variable X : Type.
Implicit Type r : relation X.

Lemma path_tur r r' adom bdom
(T: transitive r) (DA: doma r' adom) (DB: domb r' bdom) :
(r ∪ r')⁺ ≡ r ∪ (r ⨾ ⦗adom⦘ ∪ r')⁺ ⨾ (⦗bdom⦘ ⨾ r)^?.
Proof. hammer_hook "HahnPath" "HahnPath.path_tur".
split.
rewrite seq_eqv_r, seq_eqv_l.
unfold seq, union, clos_refl; intros ? ? P.
apply clos_trans_tn1 in P; induction P; desf; eauto 14 using clos_trans; clear P.
apply clos_trans_t1n in IHP; induction IHP;
intuition; desf; eauto 14 using clos_trans.
rewrite inclusion_seq_eqv_r, inclusion_seq_eqv_l.
eauto using inclusion_t_r_t with hahn.
Qed.

Lemma path_ur r r' adom bdom (DA: doma r' adom) (DB: domb r' bdom) :
(r ∪ r')⁺ ≡ r⁺ ∪ (r⁺ ⨾ ⦗adom⦘ ∪ r')⁺ ⨾ (⦗bdom⦘ ⨾ r⁺)^?.
Proof. hammer_hook "HahnPath" "HahnPath.path_ur".
by ins; rewrite <- path_tur, ct_of_union_ct_l; eauto; vauto.
Qed.

Lemma path_tur2 r r' adom bdom
(T: transitive r')
(DA: doma r adom) (DB: domb r bdom) :
(r ∪ r')⁺ ≡ r' ∪ (r' ⨾ ⦗adom⦘)^? ⨾ (r ∪ ⦗bdom⦘ ⨾ r')⁺.
Proof. hammer_hook "HahnPath" "HahnPath.path_tur2".
split.
rewrite seq_eqv_r, seq_eqv_l.
unfold seq, union, clos_refl; intros ? ? P.
apply clos_trans_t1n in P; induction P; desf; eauto 14 using clos_trans; clear P.
apply clos_trans_tn1 in IHP0; induction IHP0;
intuition; desf; eauto 14 using clos_trans.
rewrite inclusion_seq_eqv_r, inclusion_seq_eqv_l.
eauto using inclusion_r_t_t with hahn.
Qed.

Lemma path_ur2 r r' adom bdom (A: doma r adom) (B: domb r bdom) :
(r ∪ r')⁺ ≡ r'⁺ ∪ (r'⁺ ⨾ ⦗adom⦘)^? ⨾ (r ∪ ⦗bdom⦘ ⨾ r'⁺)⁺.
Proof. hammer_hook "HahnPath" "HahnPath.path_ur2".
ins; rewrite <- path_tur2, ct_of_union_ct_r; eauto; vauto.
Qed.

End PathDom.

Lemma clos_trans_imm :
forall X (r : relation X) (I: irreflexive r)
(T: transitive r) L (ND: NoDup L) a b
(D: forall c, r a c -> r c b -> In c L)
(REL: r a b),
(immediate r)⁺ a b.
Proof. hammer_hook "HahnPath" "HahnPath.clos_trans_imm".
intros until 3; induction ND; ins; vauto.
destruct (classic (r a x /\ r x b)) as [|N]; desf;
[apply t_trans with x|]; eapply IHND; ins;
forward eapply (D c); eauto; intro; desf; exfalso; eauto.
Qed.

Lemma clos_trans_rotl A (r r' : relation A) :
(r ⨾ r')⁺ ≡ r ⨾ (r' ⨾ r)＊ ⨾ r'.
Proof. hammer_hook "HahnPath" "HahnPath.clos_trans_rotl".
split; red; ins; unfold seq in *; desf.
by induction H; desf; eauto 10 using clos_refl_trans.
cut (exists m, clos_refl_trans (r ⨾ r') x m /\ r m z0); unfold seq in *.
by ins; desf; eapply t_rt_step; eauto.
clear H1; induction H0 using clos_refl_trans_ind_left; desf;
eauto 8 using clos_refl_trans.
Qed.

Lemma immediate_clos_trans_elim A (r : relation A) a b :
immediate r⁺ a b ->
r a b /\ (forall c, r⁺ a c -> r⁺ c b -> False).
Proof. hammer_hook "HahnPath" "HahnPath.immediate_clos_trans_elim".
unfold immediate; ins; desf; split; ins.
apply t_step_rt in H; desf.
apply clos_refl_transE in H1; desf; exfalso; eauto using t_step.
Qed.

Lemma clos_trans_immediate1 A (r : relation A) (T: transitive r) a b :
(immediate r)⁺ a b -> r a b.
Proof. hammer_hook "HahnPath" "HahnPath.clos_trans_immediate1".
unfold immediate; induction 1; desf; eauto.
Qed.

Lemma clos_trans_immediate2 A (r : relation A)
(T: transitive r) (IRR: irreflexive r) dom
(D: domb r (fun x => In x dom)) a b :
r a b ->
(immediate r)⁺ a b.
Proof. hammer_hook "HahnPath" "HahnPath.clos_trans_immediate2".
assert (D': forall c, r a c -> r c b -> In c dom).
by ins; apply D in H; desf.
clear D; revert a b D'.
remember (length dom) as n; revert dom Heqn; induction n.
by destruct dom; ins; vauto.
ins; destruct (classic (exists c, r a c /\ r c b)); desf.
2: by eapply t_step; split; ins; eauto.
forward eapply D' as X; eauto; apply in_split in X; desf.
rewrite app_length in *; ins; rewrite <- plus_n_Sm, <- app_length in *; desf.
apply t_trans with c; eapply IHn with (dom := l1 ++ l2); ins;
forward eapply (D' c0); eauto;
rewrite !in_app_iff; ins; desf; eauto; exfalso; eauto.
Qed.

Section PathUnionTransitive.

Variable A : Type.
Implicit Type r : relation A.

Lemma inclusion_seq_l r r1 r2 : r ⊆ r1 -> reflexive r2 -> r ⊆ r1 ⨾ r2.
Proof. hammer_hook "HahnPath" "HahnPath.inclusion_seq_l". firstorder. Qed.

Lemma inclusion_seq_r r r1 r2 : r ⊆ r2 -> reflexive r1 -> r ⊆ r1 ⨾ r2.
Proof. hammer_hook "HahnPath" "HahnPath.inclusion_seq_r". firstorder. Qed.

Hint Resolve inclusion_seq_l inclusion_seq_r : hahn_full.

Lemma path_ut r r' (T: transitive r') :
(r ∪ r')＊ ≡ r＊ ⨾ (r' ⨾ r⁺)＊ ⨾ r'^?.
Proof. hammer_hook "HahnPath" "HahnPath.path_ut".
split.
- apply inclusion_rt_ind; hahn_rel; eauto 4 with hahn hahn_full.
apply transitiveI.
rewrite crE at 1; relsf; unionL.
hahn_frame_r; rewrite rtE with (r:=r' ⨾ r⁺) at 1; relsf; hahn_rel.
hahn_frame_l; rewrite ct_end, !seqA; rels.
by apply inclusion_seq_rt; ins; rewrite <- seqA, <- ct_begin; eauto with hahn.
hahn_frame_l; rewrite rtE with (r:=r) at 1; relsf; hahn_rel; [|hahn_frame_r].
rewrite rtE with (r:=r' ⨾ r⁺) at 2; relsf; hahn_rel.
hahn_frame_r; rewrite ct_begin with (r:=r' ⨾ r⁺); rewrite !seqA; relsf.
by apply inclusion_seq_rt; ins; rewrite <- seqA, <- ct_begin; eauto with hahn.
by apply inclusion_seq_rt; ins; rewrite <- seqA, <- ct_begin; eauto with hahn.
- rewrite inclusion_t_rt.
eauto 10 using inclusion_seq_trans, inclusion_rt_rt2 with hahn.
Qed.

Lemma path_ut2 r r' (T: transitive r') :
(r ∪ r')⁺ ≡ r⁺ ∪ r＊⨾ (r'⨾ r⁺)＊ ⨾ r'⨾ r＊.
Proof. hammer_hook "HahnPath" "HahnPath.path_ut2".
split.
rewrite ct_end, path_ut; ins; relsf.
rewrite !seqA, (rewrite_trans_seq_cr_l T), crE; relsf; hahn_rel.
2: by rewrite (rtE r) at 3; relsf.
rewrite (rt_end (r' ⨾ r⁺)) at 1; relsf.
rewrite <- ct_end, !seqA; hahn_rel.
rewrite inclusion_t_rt with (r:=r) at 2; rewrite <- ct_end.
rewrite inclusion_t_rt with (r:=r) at 2; hahn_rel.
hahn_rel.
rewrite inclusion_t_rt, <- (rt_ct (r ∪ r')); seq_rewrite <- ct_end.
apply inclusion_seq_mon; eauto with hahn.
apply inclusion_t_t2; rewrite ct_begin; eauto with hahn.
Qed.

End PathUnionTransitive.

Section PathUnion.
Variable A : Type.
Implicit Type r : relation A.

Lemma path_ut_first r r' :
(r ∪ r')⁺ ≡ r⁺ ∪ r＊ ⨾ r' ⨾ (r ∪ r')＊.
Proof. hammer_hook "HahnPath" "HahnPath.path_ut_first".
split.
- apply inclusion_t_ind_right.
+ apply inclusion_union_l.
* apply inclusion_union_r; left; eauto with hahn.
* apply inclusion_union_r; right; basic_solver 10.
+ relsf; repeat apply inclusion_union_l.
* apply inclusion_union_r; left.
unfold inclusion, seq; ins; desf; vauto.
* apply inclusion_union_r; right.
rewrite !seqA.
arewrite (r ⊆ (r ∪ r')＊) at 3.
rewrite rt_rt.
done.
* basic_solver 10.
* apply inclusion_union_r; right.
rewrite !seqA.
arewrite (r' ⊆ (r ∪ r')＊) at 3.
rewrite rt_rt.
done.
- arewrite (r ⊆ (r ∪ r')⁺) at 1.
arewrite (r＊ ⊆ (r ∪ r')＊) at 1.
arewrite (r' ⊆ (r ∪ r')⁺) at 3.
rels.
Qed.

Lemma path_ut_last r r' :
(r ∪ r')⁺ ≡ r⁺ ∪ (r ∪ r')＊ ⨾ r' ⨾ r＊.
Proof. hammer_hook "HahnPath" "HahnPath.path_ut_last".
split.
- apply inclusion_t_ind_right.
+ unionL; [unionR left | unionR right]; firstorder.
+ relsf; unionL.
* rewrite ct_end at 2; basic_solver 10.
* rewrite !seqA; rewrite <- ct_end; basic_solver 10.
* arewrite (r ⊆ (r ∪ r')); basic_solver 10.
* arewrite (r ⊆ (r ∪ r')) at 2.
arewrite (r' ⊆ (r ∪ r')＊) at 2.
rels; basic_solver 10.
- arewrite (r ⊆ (r ∪ r')⁺) at 1.
arewrite (r ⊆ (r ∪ r')＊) at 3. arewrite (r' ⊆ (r ∪ r')⁺) at 3.
rels.
Qed.

Lemma path_union (r r': relation A) : (r ∪ r')⁺ ⊆ r⁺ ∪ (r＊ ⨾ r')⁺ ⨾ r＊.
Proof. hammer_hook "HahnPath" "HahnPath.path_union".
apply inclusion_t_ind_right.
unionL; [vauto|].
by rewrite rtE; rewrite <- !ct_step; basic_solver 12.
relsf; unionL.
- by unionR left; rewrite ct_unit.
- by rewrite !seqA; rewrite <- ct_end; basic_solver 12.
- rewrite (ct_step (r⁺ ⨾ r')).
rewrite <- inclusion_t_rt at 1; basic_solver 22.
- rewrite !seqA, inclusion_t_rt at 1.
rewrite <- (ct_end (r＊ ⨾ r')); basic_solver 12.
Qed.

Lemma path_union1 (r r': relation A) : (r ∪ r')⁺ ⊆ r'⁺ ∪ r'＊ ⨾ (r ∪ r ⨾ r'⁺)⁺.
Proof. hammer_hook "HahnPath" "HahnPath.path_union1".
apply inclusion_t_ind_right.
unionL; [|vauto].
by rewrite rtE; rewrite <- !ct_step; basic_solver 12.
relsf; unionL; rewrite ?seqA.
- unionR right.
arewrite (r'⁺ ⊆ r'＊); hahn_frame.
rewrite <- !ct_step; basic_solver 12.
- by arewrite (r ⊆ (r ∪ r ⨾ r'⁺)＊) at 3; relsf.
- arewrite (r'⁺ ⊆ r'＊) at 1.
rewrite <- ct_end; basic_solver.
- unionR right.
rewrite ct_end, !seqA.
arewrite ((r ∪ r ⨾ r'⁺) ⨾ r' ⊆ (r ∪ r ⨾ r'⁺)).
relsf; unionL.
* rewrite <- !ct_step; basic_solver 12.
* rewrite !seqA.
arewrite (r'⁺ ⊆ r'＊) at 1.
rewrite <- ct_end; basic_solver.
* relsf.
Qed.

Lemma path_union2 (r r': relation A) :
(r ∪ r')⁺ ⊆ r⁺ ∪ r'⁺ ⨾ r＊ ∪ r'＊ ⨾ (r⁺ ⨾ r'⁺)⁺ ⨾ r＊.
Proof. hammer_hook "HahnPath" "HahnPath.path_union2".
rewrite path_union1; unionL.
basic_solver 12.
rewrite path_union.
relsf.
unionL.
basic_solver 12.
arewrite (r＊ ⨾ r ⊆ r⁺).
basic_solver 12.
Qed.
End PathUnion.

Lemma ct_minus_transitive {A} (r r': relation A) (TR : transitive r) :
r'⁺ \ r ⊆ (r' ∩ r)＊ ⨾  (r' \ r) ⨾  r'＊.
Proof. hammer_hook "HahnPath" "HahnPath.ct_minus_transitive".
ins.
arewrite (r' ⊆ (r' ∩ r) ∪ (r' \ r)) at 1.
{ by unfolder; ins; desf; tauto. }
rewrite path_ut_first, minus_union_l.
unionL.
{  by arewrite (r' ∩ r ⊆ r); relsf. }
arewrite ((r' ∩ r) ∪ (r' \ r) ⊆ r') at 1.
basic_solver 12.
Qed.

Lemma path_utd_helper :
forall X (r r' : relation X) (T: transitive r') dom
(F: is_total dom r') (DA: doma r' dom) (DB: domb r' dom) x y
(P: clos_trans (fun x y => r x y \/ r' x y) x y),
r⁺ x y \/
(exists z w, r＊ x z /\ r' z w /\ r＊ w y) \/
(exists z w, r' z w /\ r＊ w z).
Proof. hammer_hook "HahnPath" "HahnPath.path_utd_helper".
ins; induction P; desf; eauto 9 using clos_trans, clos_refl_trans, clos_trans_in_rt.
right; destruct (classic (z1 = w)) as [|NEQ]; desf; eauto 8 using clos_refl_trans.
eapply F in NEQ; desf; eauto 8 using clos_refl_trans.
Qed.

Lemma path_utd :
forall X (r r' : relation X) (T: transitive r') dom
(F: is_total dom r') (DA: doma r' dom) (DB: domb r' dom)
(I': irreflexive (r' ⨾ r＊)),
(r ∪ r')⁺ ≡ r⁺ ∪ r＊ ⨾ r' ⨾ r＊.
Proof. hammer_hook "HahnPath" "HahnPath.path_utd".
split.
unfold inclusion, seq, union in *; ins; desf.
eapply path_utd_helper with (2:=F) in H; desf; eauto 8; exfalso; eauto 8.
apply inclusion_union_l; eauto with hahn.
rewrite <- rt_ct, ct_begin; eauto with hahn.
Qed.

Lemma ct_no_step A (r : relation A) (D: r ⨾ r ≡ ∅₂) : r⁺ ≡ r.
Proof. hammer_hook "HahnPath" "HahnPath.ct_no_step".
by apply ct_of_trans, transitiveI; rewrite D.
Qed.

Lemma ct_ct_disj A (r : relation A) (D: r ⨾ r ≡ ∅₂) : r⁺ ⨾ r⁺ ≡ ∅₂.
Proof. hammer_hook "HahnPath" "HahnPath.ct_ct_disj".
rewrite ct_no_step; ins.
Qed.

Lemma irreflexive_disj A (r : relation A) (D: r ⨾ r ≡ ∅₂) : irreflexive r.
Proof. hammer_hook "HahnPath" "HahnPath.irreflexive_disj".
red; ins; eapply D; vauto.
Qed.

Lemma path_unc X (r r' : relation X)
(A : r ⨾ r ≡ ∅₂)
(B : r' ⨾ r' ≡ ∅₂) :
(r ∪ r')＊ ≡
(r ⨾ r')＊ ∪ (r' ⨾ r)＊ ∪ r ⨾ (r' ⨾ r)＊ ∪ r' ⨾ (r ⨾ r')＊.
Proof. hammer_hook "HahnPath" "HahnPath.path_unc".
split.
eapply inclusion_rt_ind_left; eauto with hahn.
rewrite seq_union_l, !seq_union_r, <- !seqA, <- !ct_begin.
rewrite (seq_rtE_r r (r ⨾ r')), (seq_rtE_r r' (r' ⨾ r)), <- !seqA.
rewrite A, B, ?seq_false_l, ?union_false_l, ?union_false_r.
by unfold union, seq; red; ins; desf;
eauto 6 using clos_trans_in_rt, rt_refl.
hahn_rel;
repeat first [apply inclusion_union_l|apply inclusion_seq_rt|
eapply inclusion_rt_rt2]; vauto.
Qed.

Lemma pathp_unc X (r r' : relation X)
(A : r ⨾ r ≡ ∅₂)
(B : r' ⨾ r' ≡ ∅₂) :
(r ∪ r')⁺ ≡ (r ⨾ r')⁺ ∪ (r' ⨾ r)⁺ ∪ r ⨾ (r' ⨾ r)＊ ∪ r' ⨾ (r ⨾ r')＊.
Proof. hammer_hook "HahnPath" "HahnPath.pathp_unc".
rewrite ct_begin, path_unc; ins.
rewrite seq_union_l, !seq_union_r, <- !seqA, <- !ct_begin.
rewrite (seq_rtE_r r (seq r r')), (seq_rtE_r r' (seq r' r)), <- !seqA.
rewrite A, B, ?seq_false_l, ?union_false_l, ?union_false_r.
by unfold union, seq; split; red; ins; desf; eauto 8 using rt_refl.
Qed.

Lemma path_specific_absorb A (r r' : relation A) :
r ⨾ r' ⊆ r ⨾ r ->
r' ⨾ r' ⊆ r' ⨾ r ->
(r ∪ r')⁺ ⊆ r⁺ ∪ r' ⨾ r＊.
Proof. hammer_hook "HahnPath" "HahnPath.path_specific_absorb".
ins.
assert (r⁺ ⨾ r' ⊆ r⁺) by
(by rewrite ct_end, !seqA, H, <- seqA; rewrite rt_unit at 1).
apply inclusion_t_ind_right.
-
unionL.
+ unionR left. apply ct_step.
+ unionR right; basic_solver 25.
-
relsf; unionL.
+  by unionR left; rewrite ct_unit.
+  by unionR right; rewrite !seqA, rt_unit.
+  by unionR left; rewrite H1.
+
rewrite rtE at 1; relsf; unionL; unionR right.
* by rewrite H0; arewrite (r ⊆ r＊) at 1.
* by rewrite !seqA, H1, inclusion_t_rt.
Qed.

Lemma pow_union_decomposition (n : nat) A (r r': relation A) :
(r ∪ r')^^n ⊆ r'^^n ∪ (⋃k < n, r'^^k ⨾ r ⨾ (r ∪ r')^^(n - k - 1)).
Proof. hammer_hook "HahnPath" "HahnPath.pow_union_decomposition".
induction n using (well_founded_ind Wf_nat.lt_wf).
destruct n as [| n']; [by firstorder|].
simpl (_ ^^ (S n')).
rewrite !seq_pow_l, H; clear H; try done.
autorewrite with hahn; autorewrite with hahn hahn_full.
unionL; eauto with hahn.
- unionR right; eapply inclusion_bunion_r with 0; ins; try omega; rels.
replace (n' - 0) with n' by omega; eauto with hahn.
- unionR right; eapply inclusion_bunion_r with 0; ins; try omega; rels.
hahn_frame_l.
arewrite (r ⊆ (r ∪ r') ^^ 1) at 1 by simpl; rels.
arewrite (r' ⊆ r ∪ r') at 1; rewrite !pow_nm.
replace (x + (1 + (n' - x - 1))) with (n' - 0) by omega; rels.
- unionR right; eapply inclusion_bunion_r with (S x); ins; try omega; rels.
by rewrite seq_pow_l, !seqA.
Qed.

Lemma ct_inclusion_from_rt_inclusion1 A (r r': relation A)
(d d' : A -> Prop) (ACYC : acyclic r) :
r＊ ⨾ ⦗d⦘ ⊆ ⦗d'⦘ ⨾ r'＊ -> r⁺ ⨾ ⦗d⦘ ⊆ ⦗d'⦘ ⨾ r'⁺.
Proof. hammer_hook "HahnPath" "HahnPath.ct_inclusion_from_rt_inclusion1".
rewrite !rtE; autounfold with unfolderDb; ins; desf.
specialize (H x y); desf.
assert (d' x /\ (x = y /\ True \/ r'⁺ x y)).
{ edestruct H; eauto. desf; eauto. }
desf; eauto.
exfalso; eapply ACYC; edone.
Qed.

Lemma ct_inclusion_from_rt_inclusion2 A (r r': relation A)
(d d' : A -> Prop) (ACYC : acyclic r) :
⦗d⦘ ⨾ r＊ ⊆ r'＊ ⨾ ⦗d'⦘ -> ⦗d⦘ ⨾ r⁺ ⊆ r'⁺ ⨾ ⦗d'⦘.
Proof. hammer_hook "HahnPath" "HahnPath.ct_inclusion_from_rt_inclusion2".
rewrite !rtE; autounfold with unfolderDb; ins; desf.
specialize (H z y); desf.
assert (d' y /\ (z = y /\ True \/ r'⁺ z y)).
{ edestruct H; eauto. desf; eauto. }
desf; eauto.
exfalso; eapply ACYC; edone.
Qed.


(**************************************************************************
* TLC: A library for Coq                                                  *
* Shared definitions for containers                                       *
**************************************************************************)

Set Implicit Arguments.
From TLC Require Import LibTactics LibLogic LibReflect
  LibRelation LibOperation LibInt LibMonoid.
Generalizable Variables A B K T.

(* ********************************************************************** *)
(** * Operators *)

(* ---------------------------------------------------------------------- *)
(** ** Definitions *)

Class BagEmpty T := { empty : T }.
Class BagSingle A T := { single : A -> T }.
Class BagSingleBind A B T := { single_bind : A -> B -> T }.
Class BagIn A T := { is_in : A -> T -> Prop }.
Class BagBinds A B T := { binds : T -> A -> B -> Prop }.
Class BagRead A B T := { read : T -> A -> B }.
Class BagUpdate A B T := { update : T -> A -> B -> T }.
Class BagUnion T := { union : T -> T -> T }.
Class BagInter T := { inter : T -> T -> T }.
Class BagIncl T := { incl : binary T }.
Class BagDisjoint T := { disjoint : binary T }.
Class BagRestrict T K := { restrict : T -> K -> T }.
Class BagRemove T K := { remove : T -> K -> T }.
Class BagFold I F T := { fold : monoid_op I -> F -> T -> I }.
Class BagCard T := { card : T -> nat }.
Class BagDom T K := { dom : T -> K }.
Class BagImg T K := { img : T -> K }.
Class BagIndex A T := { index : T -> A -> Prop }.

Definition notin `{BagIn A T} x m :=
  ~ (is_in x m).

(*-- LATER: make [finite] a typeclass *)

(* ---------------------------------------------------------------------- *)
(** ** Notation *)

Declare Scope container_scope.

Notation "\{}" := (empty)
  : container_scope.
Notation "\{ x }" := (single x)
  : container_scope.
Notation "x '\in' m" := (is_in x m)
  (at level 39) : container_scope.
Notation "x '\notin' E" := (notin x E)
  (at level 39) : container_scope.
Notation "x \:= v" := (single_bind x v)
  (at level 29) : container_scope.
Notation "m [ x ]" := (read m x)
  (at level 7, format "m [ x ]", left associativity).
Notation "m [ x := v ]" := (update m x v)
  (at level 7, format "m [ x := v ]", left associativity).

(* DEPRECATED
Notation "m [ x ]" := (read m x)
  (at level 9, format "m [ x ]").
Notation "m [ x := v ]" := (update m x v)
  (at level 9, format "m [ x  :=  v ]").
*)

(* DEPRECATED
Notation "m \( x )" := (read m x)
  (at level 33, format "m \( x )", only parsing) : container_scope.
Notation "m \( x := v )" := (update m x v)
  (at level 33, format "m \( x := v )", only parsing) : container_scope.
*)

Notation "m1 '\c' m2" := (incl m1 m2)
  (at level 38) : container_scope.
Notation "m1 '\u' m2" := (union m1 m2)
  (at level 37, right associativity) : container_scope.
Notation "m1 '\n' m2" := (inter m1 m2)
  (at level 36, right associativity) : container_scope.
Notation "m1 '\-' m2" := (remove m1 m2)
  (at level 35) : container_scope.
Notation "m1 '\|' m2" := (restrict m1 m2)
  (at level 34) : container_scope.
Notation "m1 '\#' m2" := (disjoint m1 m2)
  (at level 37, right associativity) : container_scope.

Open Scope container_scope.

(* --TODO: bug with spaces *)
Notation "''{' x '}'" := (single x) (format "''{' x '}'")
  : container_scope.

Notation "M \-- i" := (M \- \{i}) (at level 35) : container_scope.

(* ---------------------------------------------------------------------- *)
(** ** [forall x \in E, P x] notation *)

Notation "'forall_' x '\in' E ',' P" :=
  (forall x, x \in E -> P)
  (at level 200, x ident) : container_scope.
Notation "'forall_' x y '\in' E ',' P" :=
  (forall x y, x \in E -> y \in E -> P)
  (at level 200, x ident, y ident) : container_scope.
Notation "'forall_' x y z '\in' E ',' P" :=
  (forall x y z, x \in E -> y \in E -> z \in E -> P)
  (at level 200, x ident, y ident, z ident) : container_scope.

(* ---------------------------------------------------------------------- *)
(** ** [exists x \in E st P x] notation *)

Notation "'exists_' x '\in' E ',' P" :=
  (exists x, x \in E /\ P)
  (at level 200, x ident) : container_scope.
Notation "'exists_' x y '\in' E ',' P" :=
  (exists x, x \in E /\ y \in E /\ P)
  (at level 200, x ident, y ident) : container_scope.
Notation "'exists_' x y z '\in' E ',' P" :=
  (exists x, x \in E /\ y \in E /\ z \in E /\ P)
  (at level 200, x ident, y ident, z ident) : container_scope.

(* ---------------------------------------------------------------------- *)
(** ** Foreach *)

Definition foreach `{BagIn A T} (P:A->Prop) (E:T) :=
  forall x, x \in E -> P x.

(* ---------------------------------------------------------------------- *)
(** ** [index] for natural numbers *)

Local Open Scope Int_scope.

#[global]
Instance int_index : BagIndex int int.
Proof using. intros. constructor. exact (fun n (i:int) => 0 <= i < n). Defined.

Lemma int_index_eq : forall (n i : int),
  index n i = (0 <= i < n).
Proof using. auto. Qed.

Global Opaque int_index.

Lemma int_index_le : forall i n m : int,
  index n i -> n <= m -> index m i.
Proof using. introv. do 2 rewrite @int_index_eq. math. Qed.

Lemma int_index_prove : forall (n i : int),
  0 <= i -> i < n -> index n i.
Proof using. intros. rewrite~ int_index_eq. Qed.

Lemma int_index_succ : forall n i, n >= 0 ->
  index (n + 1) i = (index n i \/ i = n).
Proof using.
  introv P. do 2 rewrite int_index_eq. extens. iff H.
  apply or_classic_l. math.
  destruct H; math.
Qed.

(* ---------------------------------------------------------------------- *)
(** ** Derivable *)

(** Bag update can be defined as bag union with a singleton bag *)

#[global]
Instance bag_update_as_union_single : forall A B T
  `{BagSingleBind A B T} `{BagUnion T},
  BagUpdate A B T.
  constructor. apply (fun m k v => m \u (k \:= v)). Defined.

Global Opaque bag_update_as_union_single.

(* ---------------------------------------------------------------------- *)
(** ** Properties *)

Section Properties.

Context {A T:Type}
  {BI: BagIn A T} {BE: BagEmpty T} {BS: BagSingle A T}
  {BN: BagInter T} {BU: BagUnion T} {BR: BagRemove T T} {BC: BagCard T}
  {BL: BagIncl T} {BD: BagDisjoint T}.

(** In *)

Class In_empty_eq :=
  { in_empty_eq : forall x, x \in \{} = False }.
Class In_empty :=
  { in_empty : forall x, x \in \{} -> False }.

Class Notin_eq :=
  { notin_eq : forall x E, (x \notin E) = ~ (x \in E) }.
Class Notin_empty :=
  { notin_empty : forall x, x \notin \{} }.

Class In_single_eq :=
  { in_single_eq : forall x y, x \in \{y} = (x = y) }.
Class In_single :=
  { in_single : forall x y, x \in \{y} -> x = y }.
Class In_single_self :=
  { in_single_self : forall x, x \in \{x} }.

Class In_extens_eq :=
  { in_extens_eq : forall E F, (forall x, x \in E = x \in F) -> E = F }.
Class In_extens :=
  { in_extens : forall E F, (forall x, x \in E <-> x \in F) -> E = F }.

Class Is_empty_eq :=
  { is_empty_eq : forall E, (E = \{}) = (forall x, x \in E -> False) }.
Class Is_empty_prove :=
  { is_empty_prove : forall E, (forall x, x \in E -> False) -> E = \{} }.
Class Is_empty_inv :=
  { is_empty_inv : forall x E, E = \{} -> x \in E -> False }.
Class Is_nonempty_prove :=
  { is_nonempty_prove : forall x E, x \in E -> E <> \{} }.

Class Is_single_eq :=
  { is_single_eq : forall x E, (E = \{x}) = (x \in E /\ (forall y, y \in E -> y = x)) }.
Class Is_single_prove :=
  { is_single_prove : forall x E, x \in E -> (forall y, y \in E -> y = x) -> E = \{x} }.
Class Is_single_inv :=
  { is_single_inv : forall x y E, E = \{x} -> y \in E -> y = x }.
Class Notin_single_eq :=
  { notin_single_eq : forall x y, x \notin \{y} = (x <> y) }.

Class In_inter_eq :=
  { in_inter_eq : forall x E F, x \in (E \n F) = (x \in E /\ x \in F) }.
Class In_inter :=
  { in_inter : forall x E F, x \in E -> x \in F -> x \in (E \n F) }.
Class In_inter_inv :=
  { in_inter_inv : forall x E F, x \in (E \n F) -> x \in E /\ x \in F }.

Class Notin_inter_eq :=
  { notin_inter_eq : forall x E F, x \notin (E \n F) = (x \notin E \/ x \notin F) }.
Class Notin_inter_l :=
  { notin_inter_l : forall x E F, x \notin E -> x \notin (E \n F) }.
Class Notin_inter_r :=
  { notin_inter_r : forall x E F, x \notin F -> x \notin (E \n F) }.
Class Notin_inter_inv :=
  { notin_inter_inv : forall x E F, x \notin (E \n F) -> x \notin E \/ x \notin F }.

Class In_union_eq :=
  { in_union_eq : forall x (E F : T), x \in (E \u F) = (x \in E \/ x \in F) }.
Class In_union_l :=
  { in_union_l : forall x E F, x \in E -> x \in (E \u F) }.
Class In_union_r :=
  { in_union_r : forall x E F, x \in F -> x \in (E \u F) }.
Class In_union_inv :=
  { in_union_inv : forall x (E F : T), x \in (E \u F) -> (x \in E \/ x \in F) }.

Class Notin_union_eq :=
  { notin_union_eq : forall x E F, x \notin (E \u F) = (x \notin E /\ x \notin F) }.
Class Notin_union :=
  { notin_union : forall x E F, x \notin E -> x \notin F -> x \notin (E \u F) }.
Class Notin_union_inv :=
  { notin_union_inv : forall x E F, x \notin (E \u F) -> x \notin E /\ x \notin F }.

Class In_remove_eq :=
  { in_remove_eq : forall x (E F : T), x \in (E \- F) = (x \in E /\ x \notin F) }.
Class Remove_incl :=
  { remove_incl : forall (E F : T), (E \- F) \c E }.
Class Remove_disjoint :=
  { remove_disjoint : forall (E F : T), F \# (E \- F) }.

(** Incl *)

Class Incl_in_eq :=
  { incl_in_eq : forall E F, (E \c F) = (forall x, x \in E -> x \in F) }.
Class Incl_prove :=
  { incl_prove : forall E F, (forall x, x \in E -> x \in F) -> E \c F }.
Class Incl_inv :=
  { incl_inv : forall x E F, E \c F -> x \in E -> x \in F}.

Class Incl_refl :=
  { incl_refl : refl incl }.
Class Incl_trans :=
  { incl_trans : trans incl }.
Class Incl_antisym := (* this is double inclusion *)
  { incl_antisym : antisym incl }.
Class Incl_order :=
  { incl_order : LibOrder.order incl }.

Class Empty_incl :=
  { empty_incl : forall E, \{} \c E }.
Class Incl_empty :=
  { incl_empty : forall E, (E \c \{}) = (E = \{}) }.
Class Incl_empty_inv :=
  { incl_empty_inv : forall E, E \c \{} -> E = \{} }.

Class Single_incl_r_eq :=
  { single_incl_r_eq : forall x E, (\{x} \c E) = (x \in E) }.
Class Single_incl_r :=
  { single_incl_r : forall x E, x \in E -> \{x} \c E }.

Class Single_incl_l_eq :=
  { single_incl_l_eq : forall x E, (E \c \{x}) = (E = \{} \/ E = \{x}) }.

Class Incl_union_l :=
  { incl_union_l : forall E F G, E \c F -> E \c (F \u G) }.
Class Incl_union_r :=
  { incl_union_r : forall E F G, E \c G -> E \c (F \u G) }.

Class Union_incl_eq :=
  { union_incl_eq : forall E F G, ((E \u F) \c G) = (E \c G /\ F \c G) }.
Class Union_incl :=
  { union_incl : forall E F G, E \c G -> F \c G -> (E \u F) \c G }.
Class Union_incl_inv :=
  { union_incl_inv : forall E F G, (E \u F) \c G -> E \c G /\ F \c G }.
Class Union_incl_union :=
  { union_incl_union : forall E1 F1 E2 F2, E1 \c F1 -> E2 \c F2 -> (E1 \u E2) \c (F1 \u F2) }.
Class Union_incl_union_same_l :=
  { union_incl_union_same_l : forall E F1 F2, F1 \c F2 -> (E \u F1) \c (E \u F2) }.
Class Union_incl_union_same_r :=
  { union_incl_union_same_r : forall E F1 F2, F1 \c F2 -> (F1 \u E) \c (F2 \u E) }.

Class Incl_inter_eq :=
  { incl_inter_eq : forall E F G, E \c (F \n G) = (E \c F /\ E \c G) }.
Class Incl_inter :=
  { incl_inter : forall E F G, E \c F -> E \c G -> E \c (F \n G) }.
Class Incl_inter_inv :=
  { incl_inter_inv : forall E F G, E \c (F \n G) -> E \c F /\ E \c G }.

(** Union *)

Class Union_assoc :=
  { union_assoc : assoc union }.
Class Union_comm :=
  { union_comm : comm union }.
Class Union_comm_assoc :=
  { union_comm_assoc : comm_assoc union }.
Class Union_empty_l :=
  { union_empty_l : neutral_l union empty }.
Class Union_empty_r :=
  { union_empty_r : neutral_r union empty }.
Class Union_empty_inv :=
  { union_empty_inv : forall E F, E \u F = \{} -> E = \{} /\ F = \{} }.
Class Union_self :=
  { union_self : idempotent2 union }.

(** Intersection *)

Class Inter_assoc :=
  { inter_assoc : assoc inter }.
Class Inter_comm :=
  { inter_comm : comm inter }.
Class Inter_comm_assoc :=
  { inter_comm_assoc : comm_assoc inter }.
Class Inter_empty_l :=
  { inter_empty_l : absorb_l inter empty }.
Class Inter_empty_r :=
  { inter_empty_r : absorb_r inter empty }.
Class Inter_self :=
  { inter_self : idempotent2 inter }.

(** Removal *)

  (* --TODO: add more *)

(** Cardinal *)

Class Card_empty :=
  { card_empty : card \{} = 0%nat }.
Class Card_single :=
  { card_single : forall X, card \{X} = 1%nat }.
Class Card_union :=
  { card_union : forall E F, card (E \u F) = (card E + card F)%nat }.
Class Card_disjoin_union :=
  { card_disjoin_union : forall E F, E \# F -> card (E \u F) = (card E + card F)%nat }.
Class Card_union_le :=
  { card_union_le : forall E F, card (E \u F) <= (card E + card F)%nat }.

(** Disjointness *)

Class Disjoint_sym :=
  { disjoint_sym : sym disjoint }.
Class Disjoint_eq :=
  { disjoint_eq : forall E F, (E \# F) = (forall x, x \in E -> x \in F -> False) }.
Class Disjoint_not_eq :=
  { disjoint_not_eq : forall E F, (~ (E \# F)) = (exists x, x \in E /\ x \in F) }.
Class Disjoint_prove :=
  { disjoint_prove : forall E F, (forall x, x \in E -> x \in F -> False) -> E \# F }.
Class Disjoint_inv :=
  { disjoint_inv : forall x E F, (E \# F) -> x \in E -> x \in F -> False }.
Class Disjoint_single_l_eq :=
  { disjoint_single_l_eq : forall x E, (\{x} \# E) = x \notin E }.
Class Disjoint_single_r_eq :=
  { disjoint_single_r_eq : forall x E, (E \# \{x}) = x \notin E }.

Class Inter_disjoint :=
  { inter_disjoint : forall E F, E \# F -> E \n F = \{} }.

  (* --TODO: add more *)

End Properties.

(** Lemmas with premises and operators in the conclusion
    need additional Arguments *)

Arguments is_empty_inv {A} {T} {BI} {BE} {Is_empty_inv} [x] [E].
Arguments is_nonempty_prove {A} {T} {BI} {BE} {Is_nonempty_prove} [x] [E].

Arguments in_single A T {BI} {BS} {In_single} [x] [y].
Arguments is_single_inv {A} {T} {BI} {BS} {Is_single_inv} [x] y [E].

Arguments in_inter {A} {T} {BI} {BN} {In_inter} [x] [E] [F].
Arguments in_inter_inv {A} {T} {BI} {BN} {In_inter_inv} [x] [E] [F].

Arguments notin_inter_l {A} {T} {BI} {BN} {Notin_inter_l} [x] [E] [F].
Arguments notin_inter_r {A} {T} {BI} {BN} {Notin_inter_r} [x] [E] [F].
Arguments notin_inter_inv {A} {T} {BI} {BN} {Notin_inter_inv} [x] [E] [F].

Arguments in_union_l {A} {T} {BI} {BU} {In_union_l} [x] [E] [F].
Arguments in_union_r {A} {T} {BI} {BU} {In_union_r} [x] [E] [F].
Arguments in_union_inv {A} {T} {BI} {BU} {In_union_inv} [x] [E] [F].

Arguments notin_union {A} {T} {BI} {BU} {Notin_union} [x] [E] [F].
Arguments notin_union_inv {A} {T} {BI} {BU} {Notin_union_inv} [x] [E] [F].

Arguments incl_prove {A} {T} {BI} {BL} {Incl_prove} [E] [F].
Arguments incl_inv {A} {T} {BI} {BL} {Incl_inv} [x] [E] [F].
Arguments incl_trans {T} [BL] {Incl_trans} y [x] [z].
Arguments incl_empty_inv {T} {BE} {BL} {Incl_empty_inv} [E].

Arguments incl_union_l {T} {BU} {BL} {Incl_union_l} [E] [F] [G].
Arguments incl_union_r {T} {BU} {BL} {Incl_union_r} [E] [F] [G].
Arguments incl_inter {T} {BN} {BL} {Incl_inter} [E] [F] [G].
Arguments incl_inter_inv {T} {BN} {BL} {Incl_inter_inv} [E] [F] [G].

Arguments union_incl_union {T} {BU} {BL} {Union_incl_union} [E1] [F1] [E2] [F2].
Arguments union_incl_union_same_l {T} {BU} {BL} {Union_incl_union_same_l} [E] [F1] [F2].
Arguments union_incl_union_same_r {T} {BU} {BL} {Union_incl_union_same_r} [E] [F1] [F2].

Arguments union_empty_inv {T} {BE} {BU} {Union_empty_inv} [E] [F].

Arguments disjoint_sym {T} {BD} {Disjoint_sym}.
Arguments disjoint_prove {A} {T} {BI} {BD} {Disjoint_prove} [E] [F].
Arguments disjoint_inv {A} {T} {BI} {BD} {Disjoint_inv} [x] [E] [F].
Arguments disjoint_single_l_eq {A} {T} {BI} {BS} {BD} {Disjoint_single_l_eq}.
Arguments disjoint_single_r_eq {A} {T} {BI} {BS} {BD} {Disjoint_single_r_eq}.

(* ---------------------------------------------------------------------- *)
(** ** Derived Properties *)

Section DerivedProperties.

Context {A T:Type}
  {BI: BagIn A T} {BE: BagEmpty T} {BS: BagSingle A T}
  {BN: BagInter T} {BU: BagUnion T} {BR: BagRemove T T} {BC: BagCard T}
  {BL: BagIncl T} {BD: BagDisjoint T}.

(** In *)

Global Instance in_empty_of_in_empty_eq :
  In_empty_eq ->
  In_empty.
Proof using. constructor. introv I. rewrite~ in_empty_eq in I. Qed.

Global Instance notin_eq_of_nothing :
  Notin_eq.
Proof using. constructor. intros. unfold notin. auto. Qed.

Global Instance notin_empty_of_in_empty_eq :
  In_empty_eq ->
  Notin_empty.
Proof using. constructor. introv I. rewrite~ in_empty_eq in I. Qed.

Global Instance in_single_of_in_single_eq :
  In_single_eq ->
  In_single.
Proof using. constructor. introv I. rewrite~ in_single_eq in I. Qed.

Global Instance in_single_self_of_in_single_eq :
  In_single_eq ->
  In_single_self.
Proof using. constructor. intros. rewrite~ in_single_eq. Qed.

Global Instance in_extens_eq_of_in_extens :
  In_extens ->
  In_extens_eq.
Proof using. constructor. introv I. apply in_extens. intros. rewrite* I. Qed.

Global Instance is_empty_eq_of_in_empty_eq :
  In_extens ->
  In_empty_eq ->
  Is_empty_eq.
Proof using.
  constructor. intros. extens. iff M.
    subst. introv N. rewrite* in_empty_eq in N.
    apply in_extens. iff N. false* M. rewrite* in_empty_eq in N.
Qed.

Global Instance is_empty_prove_of_is_empty_eq :
  Is_empty_eq ->
  Is_empty_prove.
Proof using. constructor. introv I. rewrite* is_empty_eq. Qed.

Global Instance is_empty_inv_of_is_empty_eq :
  Is_empty_eq ->
  Is_empty_inv.
Proof using. constructor. introv I1 I2. rewrite* is_empty_eq in I1. Qed.

Global Instance is_nonempty_prove_of_is_empty_eq :
  Is_empty_eq ->
  Is_nonempty_prove.
Proof using. constructor. introv I1 I2. rewrite is_empty_eq in I2. eauto. Qed.

Global Instance is_single_eq_of_in_single_eq :
  In_extens ->
  In_single_eq ->
  Is_single_eq.
Proof using.
  constructor. intros. extens. iff M (M1&M2).
    subst. split. rewrite* in_single_eq. introv N. rewrite* in_single_eq in N.
    apply in_extens. iff N.
      rewrite* (M2 x0). rewrite* in_single_eq.
      rewrite* in_single_eq in N. subst*.
Qed.

Global Instance is_single_prove_of_is_single_eq :
  Is_single_eq ->
  Is_single_prove.
Proof using. constructor. introv I. rewrite* is_single_eq. Qed.

Global Instance is_single_inv_of_is_single_eq :
  Is_single_eq ->
  Is_single_inv.
Proof using. constructor. introv I1 I2. rewrite* is_single_eq in I1. Qed.

Global Instance notin_single_eq_of_in_single_eq :
  In_single_eq ->
  Notin_single_eq.
Proof using. constructor. intros. unfold notin. rewrite in_single_eq. eauto. Qed.

Global Instance in_inter_of_in_inter_eq :
  In_inter_eq ->
  In_inter.
Proof using. constructor. introv I1 I2. rewrite* in_inter_eq. Qed.

Global Instance in_inter_inv_of_in_inter_eq :
  In_inter_eq ->
  In_inter_inv.
Proof using. constructor. introv I. rewrite~ <- in_inter_eq. Qed.

Global Instance notin_inter_l_of_notin_inter_eq :
  Notin_inter_eq ->
  Notin_inter_l.
Proof using. constructor. introv I. rewrite~ notin_inter_eq. Qed.

Global Instance notin_inter_r_of_notin_inter_eq :
  Notin_inter_eq ->
  Notin_inter_r.
Proof using. constructor. introv I. rewrite~ notin_inter_eq. Qed.

Global Instance notin_inter_inv_of_notin_inter_eq :
  Notin_inter_eq ->
  Notin_inter_inv.
Proof using. constructor. introv I. rewrite~ notin_inter_eq in I. Qed.

Global Instance in_union_l_of_in_union_eq :
  In_union_eq ->
  In_union_l.
Proof using. constructor. introv I. rewrite* in_union_eq. Qed.

Global Instance in_union_r_of_in_union_eq :
  In_union_eq ->
  In_union_r.
Proof using. constructor. introv I. rewrite* in_union_eq. Qed.

Global Instance in_union_inv_of_in_union_eq :
  In_union_eq ->
  In_union_inv.
Proof using. constructor. introv I. rewrite~ @in_union_eq in I. Qed.

Global Instance notin_union_of_notin_union_eq :
  Notin_union_eq ->
  Notin_union.
Proof using. constructor. introv I1 I2. rewrite~ notin_union_eq. Qed.

Global Instance notin_union_inv_of_notin_union_eq :
  Notin_union_eq ->
  Notin_union_inv.
Proof using. constructor. introv I. rewrite~ notin_union_eq in I. Qed.

  (* --TODO: in remove properties?*)

(** Incl *)

Global Instance incl_prove_of_in_eq :
  Incl_in_eq ->
  Incl_prove.
Proof using. constructor. introv I. rewrite* incl_in_eq. Qed.

Global Instance incl_inv_of_in_eq :
  Incl_in_eq ->
  Incl_inv.
Proof using. constructor. introv I1 I2. rewrite* incl_in_eq in I1. Qed.

Global Instance incl_order_of_incl_in_eq :
  In_extens ->
  Incl_in_eq ->
  Incl_order.
Proof using.
  constructor. constructor.
  intros x. rewrite* incl_in_eq.
  intros E F G I1 I2. rewrite incl_in_eq. rewrite incl_in_eq in I1,I2. autos*.
  intros E F I1 I2. rewrite incl_in_eq in I1,I2. apply* in_extens.
Qed.

Global Instance incl_refl_of_incl_order :
  Incl_order ->
  Incl_refl.
Proof using. constructor. apply order_refl. apply incl_order. Qed.

Global Instance incl_trans_of_incl_order :
  Incl_order ->
  Incl_trans.
Proof using. constructor. apply order_trans. apply incl_order. Qed.

Global Instance incl_antisym_of_incl_order :
  Incl_order ->
  Incl_antisym.
Proof using. constructor. apply order_antisym. apply incl_order. Qed.

Global Instance empty_incl_inv_of_incl_in_eq_and_in_empty_eq :
  Incl_in_eq ->
  In_empty_eq ->
  Empty_incl.
Proof using.
  constructor. intros. rewrite incl_in_eq. introv M.
  rewrite in_empty_eq in M. false.
Qed.

Global Instance incl_empty_of_in_empty_eq_and_incl_in_eq :
  In_extens ->
  In_empty_eq ->
  Incl_in_eq ->
  Incl_empty.
Proof using.
  constructor. intros. extens. rewrite incl_in_eq. iff M.
    apply in_extens. iff N. applys* M. rewrite in_empty_eq in N. false.
    subst. introv N. rewrite in_empty_eq in N. false.
Qed.

Global Instance incl_empty_inv_of_incl_empty :
  Incl_empty ->
  Incl_empty_inv.
Proof using. constructor. introv I. rewrite~ incl_empty in I. Qed.

Global Instance single_incl_r_eq_of_in_single_eq_and_and_incl_in_eq :
  In_extens ->
  In_single_eq ->
  Incl_in_eq ->
  Single_incl_r_eq.
Proof using.
  constructor. intros. extens. rewrite incl_in_eq. iff M.
    applys* M. rewrite~ in_single_eq.
    introv N. rewrite in_single_eq in N. subst~.
Qed.

Global Instance single_incl_r_of_single_incl_r_eq:
  Single_incl_r_eq ->
  Single_incl_r.
Proof using.
  constructor. intros. rewrite single_incl_r_eq. assumption.
Qed.

Global Instance single_incl_l_eq_of_in_empty_eq_and_in_single_eq_and_and_incl_in_eq :
  In_extens ->
  In_empty_eq ->
  In_single_eq ->
  Incl_in_eq ->
  Single_incl_l_eq.
Proof using.
  constructor. intros. extens. rewrite incl_in_eq. iff M.
    tests: (x \in E).
      right. apply* is_single_prove. introv N. forwards~ R: M y.
        rewrite* in_single_eq in R.
      left. apply in_extens. iff N. forwards~ R: M x0.
        rewrite* in_single_eq in R. subst. false*.
        rewrite in_empty_eq in N. false.
    introv N. rewrite in_single_eq. destruct M.
      subst. rewrite in_empty_eq in N. false.
      subst. rewrite in_single_eq in N. auto.
Qed.

Global Instance union_incl_eq_of_in_union_eq_and_and_incl_in_eq :
  In_extens ->
  In_union_eq ->
  Incl_in_eq ->
  Union_incl_eq.
Proof using.
  constructor. intros. extens. repeat rewrite incl_in_eq. iff M (M1&M2).
    split. intros x N. specializes M x. rewrite* in_union_eq in M.
           intros x N. specializes M x. rewrite* in_union_eq in M.
    intros x N. specializes M1 x. specializes M2 x. rewrite* in_union_eq in N.
Qed.

Global Instance union_incl_union_of_union_incl_and_incl_union_l_and_incl_union_r :
  Union_incl ->
  Incl_union_l ->
  Incl_union_r ->
  Union_incl_union.
Proof using.
  constructor. intros. apply union_incl.
  { applys* incl_union_l. } { applys* incl_union_r. }
Qed.

Global Instance union_incl_union_same_l_of_union_incl_union_and_incl_refl :
  Union_incl_union ->
  Incl_refl ->
  Union_incl_union_same_l.
Proof using.
  constructor. intros. apply union_incl_union.
  { applys* incl_refl. } { auto. }
Qed.

Global Instance union_incl_union_same_r_of_union_incl_union_same_l_and_union_comm :
  Union_incl_union_same_l ->
  Union_comm ->
  Union_incl_union_same_r.
Proof using.
  constructor. intros. rewrite (union_comm F1). rewrite (union_comm F2).
  apply union_incl_union_same_l. auto.
Qed.

Global Instance incl_union_l_of_incl_in_eq_and_in_union_eq :
  Incl_in_eq ->
  In_union_eq ->
  Incl_union_l.
Proof using.
  constructor. introv I. rewrite incl_in_eq. rewrite incl_in_eq in I.
  (* coqbug on "rewrite incl_in_eq in *" *)
  introv N. rewrite* in_union_eq.
Qed.

Global Instance incl_union_r_of_incl_union_l :
  Incl_union_l ->
  Union_comm ->
  Incl_union_r.
Proof using. constructor. introv I. rewrite union_comm. apply* @incl_union_l. Qed.

Global Instance union_incl_of_union_incl_eq :
  Union_incl_eq ->
  Union_incl_eq.
Proof using. constructor. intros_all. rewrite* union_incl_eq. Qed.

Global Instance union_incl_inv_of_union_incl_eq :
  Union_incl_eq ->
  Union_incl_inv.
Proof using. constructor. introv I. rewrite union_incl_eq in I. destruct* I. Qed.

Global Instance incl_inter_eq_of_in_inter_eq_and_and_incl_in_eq :
  In_extens ->
  In_inter_eq ->
  Incl_in_eq ->
  Incl_inter_eq.
Proof using.
  constructor. intros. extens. repeat rewrite incl_in_eq. iff M (M1&M2).
    split. intros x N. specializes M x. rewrite* in_inter_eq in M.
           intros x N. specializes M x. rewrite* in_inter_eq in M.
    intros x N. specializes M1 N. specializes M2 N. rewrite* in_inter_eq.
Qed.

Global Instance incl_inter_of_incl_inter_eq :
  Incl_inter_eq ->
  Incl_inter.
Proof using. constructor. intros. rewrite* incl_inter_eq. Qed.

Global Instance incl_inter_inv_of_incl_inter_eq :
  Incl_inter_eq ->
  Incl_inter_inv.
Proof using. constructor. introv N. rewrite* incl_inter_eq in N. Qed.

(** Local tactic [contain_by_in_double] to prove inclusion *)

Hint Rewrite @in_union_eq @in_inter_eq
  @in_empty_eq @in_single_eq : rew_in_eq.

Ltac contain_by_in_double :=
  intros_all; apply in_extens; intros;
  autorewrite with rew_in_eq;
  intuition (try solve [auto|eauto|auto_false|false]).

(** Union *)

Global Instance union_comm_form_in_union_eq :
  In_extens ->
  In_union_eq ->
  Union_comm.
Proof using. constructor. contain_by_in_double. Qed.

Global Instance union_assoc_form_in_union_eq :
  In_extens ->
  In_union_eq ->
  Union_assoc.
Proof using. constructor. contain_by_in_double. Qed.

Global Instance union_comm_assoc_of_union_comm_and_union_assoc :
  Union_comm ->
  Union_assoc ->
  Union_comm_assoc.
Proof using.
  constructor. intros_all. do 2 rewrite union_assoc.
  rewrite (union_comm _ x). auto.
Qed.

Global Instance union_empty_l_of_in_union_eq_and_in_empty_eq :
  In_extens ->
  In_union_eq ->
  In_empty_eq ->
  Union_empty_l.
Proof using. constructor. contain_by_in_double. Qed.

Global Instance union_empty_r_of_union_empty_l :
  Union_empty_l -> Union_comm -> Union_empty_r.
Proof using. constructor. intros_all. rewrite union_comm. apply union_empty_l. Qed.

Global Instance union_empty_inv_of_in_union_eq :
  In_extens ->
  In_empty_eq ->
  In_union_eq ->
  Union_empty_inv.
Proof using.
  constructor. introv N. split.
    apply in_extens. iff R. rewrite <- N. rewrite* in_union_eq. rewrite* in_empty_eq in R.
    apply in_extens. iff R. rewrite <- N. rewrite* in_union_eq. rewrite* in_empty_eq in R.
Qed.

Global Instance union_self_of_in_union_eq :
  In_extens ->
  In_union_eq ->
  Union_self.
Proof using. constructor. contain_by_in_double. Qed.

Global Instance notin_union_eq_of_in_union_eq :
  In_union_eq ->
  Notin_union_eq.
Proof using. constructor. intros. unfold notin. rewrite @in_union_eq. extens*. eauto. Qed.

(** Inter *)

Global Instance inter_comm_form_in_inter_eq :
  In_extens ->
  In_inter_eq ->
  Inter_comm.
Proof using. constructor. contain_by_in_double. Qed.

Global Instance inter_assoc_form_in_inter_eq :
  In_extens ->
  In_inter_eq ->
  Inter_assoc.
Proof using. constructor. contain_by_in_double. Qed.

Global Instance inter_comm_assoc_of_inter_comm_and_inter_assoc :
  Inter_comm ->
  Inter_assoc ->
  Inter_comm_assoc.
Proof using.
  constructor. intros_all. do 2 rewrite inter_assoc.
  rewrite (inter_comm _ x). auto.
Qed.

Global Instance inter_empty_l_of_in_inter_eq_and_in_empty_eq :
  In_extens ->
  In_inter_eq ->
  In_empty_eq ->
  Inter_empty_l.
Proof using. constructor. contain_by_in_double. Qed.

Global Instance inter_empty_r_of_inter_empty_l :
  Inter_empty_l ->
  Inter_comm ->
  Inter_empty_r.
Proof using. constructor. intros_all. rewrite inter_comm. apply inter_empty_l. Qed.

Global Instance inter_self_of_in_inter_eq :
  In_extens ->
  In_inter_eq ->
  Inter_self.
Proof using. constructor. contain_by_in_double. Qed.

(** Remove *)

Global Instance remove_incl_of_in_remove_eq_and_incl_in_eq :
  In_remove_eq ->
  Incl_in_eq ->
  Remove_incl.
Proof using.
  constructor. intros. rewrite incl_in_eq. introv N. rewrite* in_remove_eq in N.
Qed.

Global Instance remove_disjoint_of_in_remove_eq_and_disjoint_eq :
  In_remove_eq ->
  Disjoint_eq ->
  Remove_disjoint.
Proof using.
  constructor. intros. rewrite disjoint_eq. introv N M.
  rewrite* in_remove_eq in M.
Qed.

(** Disjoint *)

Global Instance disjoint_not_eq_of_disjoint_eq :
  Disjoint_eq ->
  Disjoint_not_eq.
Proof using.
  constructor. intros. rewrite disjoint_eq. extens. iff M.
  { rew_logic in M. destruct M as [x M]. rew_logic* in M. }
  { destruct M as [x M]. rew_logic. exists x. rew_logic*. }
Qed. (* --LATER: rew_logic below binder to simplify proof. *)

Global Instance disjoint_prove_of_disjoint_eq :
  Disjoint_eq ->
  Disjoint_prove.
Proof using. constructor. intros. rewrite* disjoint_eq. Qed.

Global Instance disjoint_inv_of_disjoint_eq :
  Disjoint_eq ->
  Disjoint_inv.
Proof using. constructor. introv I I1 I2. rewrite* disjoint_eq in I. Qed.

Global Instance disjoint_single_l_eq_of_disjoint_eq_and_in_single_eq :
  Disjoint_eq ->
  In_single_eq ->
  Disjoint_single_l_eq.
Proof using.
  constructor. intros. rewrite disjoint_eq. unfold notin. extens. iff M.
    introv N. specializes M N. rewrite* in_single_eq. false.
    introv N1 N2. rewrite in_single_eq in N1. subst. false.
Qed.

Global Instance disjoint_sym_of_disjoint_eq :
  Disjoint_eq ->
  Disjoint_sym.
Proof using. constructor. intros x y. do 2 rewrite* disjoint_eq. Qed.

Global Instance disjoint_single_r_eq_of_disjoint_single_l :
  Disjoint_single_l_eq ->
  Disjoint_sym ->
  Disjoint_single_r_eq.
Proof using.
  constructor. intros_all.
  rewrites (>> sym_inv_eq disjoint_sym). apply disjoint_single_l_eq.
Qed.

Global Instance inter_disjoint_of_disjoint_eq_and_in_inter_eq :
  In_extens ->
  In_empty_eq ->
  Disjoint_eq ->
  In_inter_eq ->
  Inter_disjoint.
Proof using.
  constructor. introv M. apply in_extens. rewrite disjoint_eq in M. iff N.
    rewrite in_inter_eq in N. false*.
    rewrite in_empty_eq in N. false.
Qed.

End DerivedProperties.