Theory Equivalence_Relations

(*
    Author:   Benedikt Seidl
    License:  BSD
*)

section ‹Equivalence Relations for LTL formulas›

theory Equivalence_Relations
imports
  LTL
begin

subsection ‹Language Equivalence›

definition ltl_lang_equiv :: "'a ltln ⇒ 'a ltln ⇒ bool" (infix "∼L" 75)
where
  "φ ∼L ψ ≡ ∀w. w ⊨n φ ⟷ w ⊨n ψ"

lemma ltl_lang_equiv_equivp:
  "equivp (∼L)"
  unfolding ltl_lang_equiv_def
  by (simp add: equivpI reflp_def symp_def transp_def)

lemma ltl_lang_equiv_and_true[simp]:
  "φ1 andn φ2 ∼L truen ⟷ φ1 ∼L truen ∧ φ2 ∼L truen"
  unfolding ltl_lang_equiv_def by auto

lemma ltl_lang_equiv_and_false[intro, simp]:
  "φ1 ∼L falsen ⟹ φ1 andn φ2 ∼L falsen"
  "φ2 ∼L falsen ⟹ φ1 andn φ2 ∼L falsen"
  unfolding ltl_lang_equiv_def by auto

lemma ltl_lang_equiv_or_false[simp]:
  "φ1 orn φ2 ∼L falsen ⟷ φ1 ∼L falsen ∧ φ2 ∼L falsen"
  unfolding ltl_lang_equiv_def by auto

lemma ltl_lang_equiv_or_const[intro, simp]:
  "φ1 ∼L truen ⟹ φ1 orn φ2 ∼L truen"
  "φ2 ∼L truen ⟹ φ1 orn φ2 ∼L truen"
  unfolding ltl_lang_equiv_def by auto


subsection ‹Propositional Equivalence›

fun ltl_prop_entailment :: "'a ltln set ⇒ 'a ltln ⇒ bool" (infix "⊨P" 80)
where
  "𝒜 ⊨P truen = True"
| "𝒜 ⊨P falsen = False"
| "𝒜 ⊨P φ andn ψ = (𝒜 ⊨P φ ∧ 𝒜 ⊨P ψ)"
| "𝒜 ⊨P φ orn ψ = (𝒜 ⊨P φ ∨ 𝒜 ⊨P ψ)"
| "𝒜 ⊨P φ = (φ ∈ 𝒜)"

lemma ltl_prop_entailment_monotonI[intro]:
  "S ⊨P φ ⟹ S ⊆ S' ⟹ S' ⊨P φ"
  by (induction φ) auto

lemma ltl_models_equiv_prop_entailment:
  "w ⊨n φ ⟷ {ψ. w ⊨n ψ} ⊨P φ"
  by (induction φ) auto

definition ltl_prop_equiv :: "'a ltln ⇒ 'a ltln ⇒ bool" (infix "∼P" 75)
where
  "φ ∼P ψ ≡ ∀𝒜. 𝒜 ⊨P φ ⟷ 𝒜 ⊨P ψ"

definition ltl_prop_implies :: "'a ltln ⇒ 'a ltln ⇒ bool" (infix "⟶P" 75)
where
  "φ ⟶P ψ ≡ ∀𝒜. 𝒜 ⊨P φ ⟶ 𝒜 ⊨P ψ"

lemma ltl_prop_implies_equiv:
  "φ ∼P ψ ⟷ (φ ⟶P ψ ∧ ψ ⟶P φ)"
  unfolding ltl_prop_equiv_def ltl_prop_implies_def by meson

lemma ltl_prop_equiv_equivp:
  "equivp (∼P)"
  by (simp add: ltl_prop_equiv_def equivpI reflp_def symp_def transp_def)

lemma ltl_prop_equiv_trans[trans]:
  "φ ∼P ψ ⟹ ψ ∼P χ ⟹ φ ∼P χ"
  by (simp add: ltl_prop_equiv_def)

lemma ltl_prop_equiv_true:
  "φ ∼P truen ⟷ {} ⊨P φ"
  using bot.extremum ltl_prop_entailment.simps(1) ltl_prop_equiv_def by blast

lemma ltl_prop_equiv_false:
  "φ ∼P falsen ⟷ ¬ UNIV ⊨P φ"
  by (meson ltl_prop_entailment.simps(2) ltl_prop_entailment_monotonI ltl_prop_equiv_def top_greatest)

lemma ltl_prop_equiv_true_implies_true:
  "x ∼P truen ⟹ x ⟶P y ⟹ y ∼P truen"
  by (simp add: ltl_prop_equiv_def ltl_prop_implies_def)

lemma ltl_prop_equiv_false_implied_by_false:
  "y ∼P falsen ⟹ x ⟶P y ⟹ x ∼P falsen"
  by (simp add: ltl_prop_equiv_def ltl_prop_implies_def)

lemma ltl_prop_implication_implies_ltl_implication:
  "w ⊨n φ ⟹ φ ⟶P ψ ⟹ w ⊨n ψ"
  using ltl_models_equiv_prop_entailment ltl_prop_implies_def by blast

lemma ltl_prop_equiv_implies_ltl_lang_equiv:
  "φ ∼P ψ ⟹ φ ∼L ψ"
  using ltl_lang_equiv_def ltl_prop_implication_implies_ltl_implication ltl_prop_implies_equiv by blast

lemma ltl_prop_equiv_lt_ltl_lang_equiv[simp]:
  "(∼P) ≤ (∼L)"
  using ltl_prop_equiv_implies_ltl_lang_equiv by blast


subsection ‹Constants Equivalence›

datatype tvl = Yes | No | Maybe

definition eval_and :: "tvl ⇒ tvl ⇒ tvl"
where
  "eval_and φ ψ =
    (case (φ, ψ) of
      (Yes, Yes) ⇒ Yes
    | (No, _) ⇒ No
    | (_, No) ⇒ No
    | _ ⇒ Maybe)"

definition eval_or :: "tvl ⇒ tvl ⇒ tvl"
where
  "eval_or φ ψ =
    (case (φ, ψ) of
      (No, No) ⇒ No
    | (Yes, _) ⇒ Yes
    | (_, Yes) ⇒ Yes
    | _ ⇒ Maybe)"

fun eval :: "'a ltln ⇒ tvl"
where
  "eval truen = Yes"
| "eval falsen = No"
| "eval (φ andn ψ) = eval_and (eval φ) (eval ψ)"
| "eval (φ orn ψ) = eval_or (eval φ) (eval ψ)"
| "eval φ = Maybe"

lemma eval_and_const[simp]:
  "eval_and φ ψ = No ⟷ φ = No ∨ ψ = No"
  "eval_and φ ψ = Yes ⟷ φ = Yes ∧ ψ = Yes"
  unfolding eval_and_def
  by (cases φ; cases ψ, auto)+

lemma eval_or_const[simp]:
  "eval_or φ ψ = Yes ⟷ φ = Yes ∨ ψ = Yes"
  "eval_or φ ψ = No ⟷ φ = No ∧ ψ = No"
  unfolding eval_or_def
  by (cases φ; cases ψ, auto)+

lemma eval_prop_entailment:
  "eval φ = Yes ⟷ {} ⊨P φ"
  "eval φ = No ⟷ ¬ UNIV ⊨P φ"
  by (induction φ) auto

definition ltl_const_equiv :: "'a ltln ⇒ 'a ltln ⇒ bool" (infix "∼C" 75)
where
  "φ ∼C ψ ≡ φ = ψ ∨ (eval φ = eval ψ ∧ eval ψ ≠ Maybe)"

lemma ltl_const_equiv_equivp:
  "equivp (∼C)"
  unfolding ltl_const_equiv_def
  by (intro equivpI reflpI sympI transpI) auto

lemma ltl_const_equiv_const:
  "φ ∼C truen ⟷ eval φ = Yes"
  "φ ∼C falsen ⟷ eval φ = No"
  unfolding ltl_const_equiv_def by force+

lemma ltl_const_equiv_and_const[simp]:
  "φ1 andn φ2 ∼C truen ⟷ φ1 ∼C truen ∧ φ2 ∼C truen"
  "φ1 andn φ2 ∼C falsen ⟷ φ1 ∼C falsen ∨ φ2 ∼C falsen"
  unfolding ltl_const_equiv_const by force+

lemma ltl_const_equiv_or_const[simp]:
  "φ1 orn φ2 ∼C truen ⟷ φ1 ∼C truen ∨ φ2 ∼C truen"
  "φ1 orn φ2 ∼C falsen ⟷ φ1 ∼C falsen ∧ φ2 ∼C falsen"
  unfolding ltl_const_equiv_const by force+

lemma ltl_const_equiv_other[simp]:
  "φ ∼C propn(a) ⟷ φ = propn(a)"
  "φ ∼C npropn(a) ⟷ φ = npropn(a)"
  "φ ∼C Xn ψ ⟷ φ = Xn ψ"
  "φ ∼C ψ1 Un ψ2 ⟷ φ = ψ1 Un ψ2"
  "φ ∼C ψ1 Rn ψ2 ⟷ φ = ψ1 Rn ψ2"
  "φ ∼C ψ1 Wn ψ2 ⟷ φ = ψ1 Wn ψ2"
  "φ ∼C ψ1 Mn ψ2 ⟷ φ = ψ1 Mn ψ2"
  using ltl_const_equiv_def by fastforce+

lemma ltl_const_equiv_no_const_singleton:
  "eval ψ = Maybe ⟹ φ ∼C ψ ⟹ φ = ψ"
  unfolding ltl_const_equiv_def by fastforce

lemma ltl_const_equiv_implies_prop_equiv:
  "φ ∼C truen ⟷ φ ∼P truen"
  "φ ∼C falsen ⟷ φ ∼P falsen"
  unfolding ltl_const_equiv_const eval_prop_entailment ltl_prop_equiv_def
  by auto

lemma ltl_const_equiv_no_const_prop_equiv:
  "eval ψ = Maybe ⟹ φ ∼C ψ ⟹ φ ∼P ψ"
  using ltl_const_equiv_no_const_singleton equivp_reflp[OF ltl_prop_equiv_equivp]
  by blast

lemma ltl_const_equiv_implies_ltl_prop_equiv:
  "φ ∼C ψ ⟹ φ ∼P ψ"
proof (induction ψ)
  case (And_ltln ψ1 ψ2)

  show ?case
  proof (cases "eval (ψ1 andn ψ2)")
    case Yes

    then have "φ ∼C truen"
      by (meson And_ltln.prems equivp_transp ltl_const_equiv_const(1) ltl_const_equiv_equivp)
    then show ?thesis
      by (metis (full_types) Yes ltl_const_equiv_const(1) ltl_const_equiv_implies_prop_equiv(1) ltl_prop_equiv_trans ltl_prop_implies_equiv)
  next
    case No

    then have "φ ∼C falsen"
      by (meson And_ltln.prems equivp_transp ltl_const_equiv_const(2) ltl_const_equiv_equivp)
    then show ?thesis
      by (metis (full_types) No ltl_const_equiv_const(2) ltl_const_equiv_implies_prop_equiv(2) ltl_prop_equiv_trans ltl_prop_implies_equiv)
  next
    case Maybe

    then show ?thesis
      using And_ltln.prems ltl_const_equiv_no_const_prop_equiv by force
  qed
next
  case (Or_ltln ψ1 ψ2)

  then show ?case
  proof (cases "eval (ψ1 orn ψ2)")
    case Yes

    then have "φ ∼C truen"
      by (meson Or_ltln.prems equivp_transp ltl_const_equiv_const(1) ltl_const_equiv_equivp)
    then show ?thesis
      by (metis (full_types) Yes ltl_const_equiv_const(1) ltl_const_equiv_implies_prop_equiv(1) ltl_prop_equiv_trans ltl_prop_implies_equiv)
  next
    case No

    then have "φ ∼C falsen"
      by (meson Or_ltln.prems equivp_transp ltl_const_equiv_const(2) ltl_const_equiv_equivp)
    then show ?thesis
      by (metis (full_types) No ltl_const_equiv_const(2) ltl_const_equiv_implies_prop_equiv(2) ltl_prop_equiv_trans ltl_prop_implies_equiv)
  next
    case Maybe

    then show ?thesis
      using Or_ltln.prems ltl_const_equiv_no_const_prop_equiv by force
  qed
qed (simp_all add: ltl_const_equiv_implies_prop_equiv equivp_reflp[OF ltl_prop_equiv_equivp])

lemma ltl_const_equiv_lt_ltl_prop_equiv[simp]:
  "(∼C) ≤ (∼P)"
  using ltl_const_equiv_implies_ltl_prop_equiv by blast


subsection ‹Quotient types›

quotient_type 'a ltlnL = "'a ltln" / "(∼L)"
  by (rule ltl_lang_equiv_equivp)

instantiation ltlnL :: (type) equal
begin

lift_definition ltlnL_eq_test :: "'a ltlnL ⇒ 'a ltlnL ⇒ bool" is "λx y. x ∼L y"
  by (metis ltlnL.abs_eq_iff)

definition
  eqL: "equal_class.equal ≡ ltlnL_eq_test"

instance
  by (standard; simp add: eqL ltlnL_eq_test.rep_eq, metis Quotient_ltlnL Quotient_rel_rep)

end


quotient_type 'a ltlnP = "'a ltln" / "(∼P)"
  by (rule ltl_prop_equiv_equivp)

instantiation ltlnP :: (type) equal
begin

lift_definition ltlnP_eq_test :: "'a ltlnP ⇒ 'a ltlnP ⇒ bool" is "λx y. x ∼P y"
  by (metis ltlnP.abs_eq_iff)

definition
  eqP: "equal_class.equal ≡ ltlnP_eq_test"

instance
  by (standard; simp add: eqP ltlnP_eq_test.rep_eq, metis Quotient_ltlnP Quotient_rel_rep)

end


quotient_type 'a ltlnC = "'a ltln" / "(∼C)"
  by (rule ltl_const_equiv_equivp)

instantiation ltlnC :: (type) equal
begin

lift_definition ltlnC_eq_test :: "'a ltlnC ⇒ 'a ltlnC ⇒ bool" is "λx y. x ∼C y"
  by (metis ltlnC.abs_eq_iff)

definition
  eqC: "equal_class.equal ≡ ltlnC_eq_test"

instance
  by (standard; simp add: eqC ltlnC_eq_test.rep_eq, metis Quotient_ltlnC Quotient_rel_rep)

end



subsection ‹Cardinality of propositional quotient sets›

definition sat_models :: "'a ltlnP ⇒ 'a ltln set set"
where
  "sat_models φ = {𝒜. 𝒜 ⊨P rep_ltlnP φ}"

lemma Rep_Abs_prop_entailment[simp]:
  "𝒜 ⊨P rep_ltlnP (abs_ltlnP φ) = 𝒜 ⊨P φ"
  by (metis Quotient3_ltlnP Quotient3_rep_abs ltl_prop_equiv_def)

lemma sat_models_Abs:
  "𝒜 ∈ sat_models (abs_ltlnP φ) = 𝒜 ⊨P φ"
  by (simp add: sat_models_def)

lemma sat_models_inj:
  "inj sat_models"
proof (rule injI)
  fix φ ψ :: "'a ltlnP"
  assume "sat_models φ = sat_models ψ"

  then have "rep_ltlnP φ ∼P rep_ltlnP ψ"
    unfolding sat_models_def ltl_prop_equiv_def by force

  then show "φ = ψ"
    by (meson Quotient3_ltlnP Quotient3_rel_rep)
qed


fun prop_atoms :: "'a ltln ⇒ 'a ltln set"
where
  "prop_atoms truen = {}"
| "prop_atoms falsen = {}"
| "prop_atoms (φ andn ψ) = prop_atoms φ ∪ prop_atoms ψ"
| "prop_atoms (φ orn ψ) = prop_atoms φ ∪ prop_atoms ψ"
| "prop_atoms φ = {φ}"

fun nested_prop_atoms :: "'a ltln ⇒ 'a ltln set"
where
  "nested_prop_atoms truen = {}"
| "nested_prop_atoms falsen = {}"
| "nested_prop_atoms (φ andn ψ) = nested_prop_atoms φ ∪ nested_prop_atoms ψ"
| "nested_prop_atoms (φ orn ψ) = nested_prop_atoms φ ∪ nested_prop_atoms ψ"
| "nested_prop_atoms (Xn φ) = {Xn φ} ∪ nested_prop_atoms φ"
| "nested_prop_atoms (φ Un ψ) = {φ Un ψ} ∪ nested_prop_atoms φ ∪ nested_prop_atoms ψ"
| "nested_prop_atoms (φ Rn ψ) = {φ Rn ψ} ∪ nested_prop_atoms φ ∪ nested_prop_atoms ψ"
| "nested_prop_atoms (φ Wn ψ) = {φ Wn ψ} ∪ nested_prop_atoms φ ∪ nested_prop_atoms ψ"
| "nested_prop_atoms (φ Mn ψ) = {φ Mn ψ} ∪ nested_prop_atoms φ ∪ nested_prop_atoms ψ"
| "nested_prop_atoms φ = {φ}"

lemma prop_atoms_nested_prop_atoms:
  "prop_atoms φ ⊆ nested_prop_atoms φ"
  by (induction φ) auto

lemma prop_atoms_subfrmlsn:
  "prop_atoms φ ⊆ subfrmlsn φ"
  by (induction φ) auto

lemma nested_prop_atoms_subfrmlsn:
  "nested_prop_atoms φ ⊆ subfrmlsn φ"
  by (induction φ) auto

lemma prop_atoms_notin[simp]:
  "truen ∉ prop_atoms φ"
  "falsen ∉ prop_atoms φ"
  "φ1 andn φ2 ∉ prop_atoms φ"
  "φ1 orn φ2 ∉ prop_atoms φ"
  by (induction φ) auto

lemma nested_prop_atoms_notin[simp]:
  "truen ∉ nested_prop_atoms φ"
  "falsen ∉ nested_prop_atoms φ"
  "φ1 andn φ2 ∉ nested_prop_atoms φ"
  "φ1 orn φ2 ∉ nested_prop_atoms φ"
  by (induction φ) auto

lemma prop_atoms_finite:
  "finite (prop_atoms φ)"
  by (induction φ) auto

lemma nested_prop_atoms_finite:
  "finite (nested_prop_atoms φ)"
  by (induction φ) auto

lemma prop_atoms_entailment_iff:
  "φ ∈ prop_atoms ψ ⟹ 𝒜 ⊨P φ ⟷ φ ∈ 𝒜"
  by (induction φ) auto

lemma prop_atoms_entailment_inter:
  "prop_atoms φ ⊆ P ⟹ (𝒜 ∩ P) ⊨P φ = 𝒜 ⊨P φ"
  by (induction φ) auto

lemma nested_prop_atoms_entailment_inter:
  "nested_prop_atoms φ ⊆ P ⟹ (𝒜 ∩ P) ⊨P φ = 𝒜 ⊨P φ"
  by (induction φ) auto

lemma sat_models_inter_inj_helper:
  assumes
    "prop_atoms φ ⊆ P"
  and
    "prop_atoms ψ ⊆ P"
  and
    "sat_models (abs_ltlnP φ) ∩ Pow P = sat_models (abs_ltlnP ψ) ∩ Pow P"
  shows
    "φ ∼P ψ"
proof -
  from assms have "∀𝒜. (𝒜 ∩ P) ⊨P φ ⟷ (𝒜 ∩ P) ⊨P ψ"
    by (auto simp: sat_models_Abs)

  with assms show "φ ∼P ψ"
    by (simp add: prop_atoms_entailment_inter ltl_prop_equiv_def)
qed

lemma sat_models_inter_inj:
  "inj_on (λφ. sat_models φ ∩ Pow P) {abs_ltlnP φ |φ. prop_atoms φ ⊆ P}"
  by (auto simp: inj_on_def sat_models_inter_inj_helper ltlnP.abs_eq_iff)

lemma sat_models_pow_pow:
  "{sat_models (abs_ltlnP φ) ∩ Pow P | φ. prop_atoms φ ⊆ P} ⊆ Pow (Pow P)"
  by (auto simp: sat_models_def)

lemma sat_models_finite:
  "finite P ⟹ finite {sat_models (abs_ltlnP φ) ∩ Pow P | φ. prop_atoms φ ⊆ P}"
  using sat_models_pow_pow finite_subset by fastforce

lemma sat_models_card:
  "finite P ⟹ card ({sat_models (abs_ltlnP φ) ∩ Pow P | φ. prop_atoms φ ⊆ P}) ≤ 2 ^ 2 ^ card P"
  by (metis (mono_tags, lifting) sat_models_pow_pow Pow_def card_Pow card_mono finite_Collect_subsets)


lemma image_filter:
  "f ` {g a | a. P a} = {f (g a) | a. P a}"
  by blast

lemma prop_equiv_finite:
  "finite P ⟹ finite {abs_ltlnP ψ | ψ. prop_atoms ψ ⊆ P}"
  by (auto simp: image_filter sat_models_finite finite_imageD[OF _ sat_models_inter_inj])

lemma prop_equiv_card:
  "finite P ⟹ card {abs_ltlnP ψ | ψ. prop_atoms ψ ⊆ P} ≤ 2 ^ 2 ^ card P"
  by (auto simp: image_filter sat_models_card card_image[OF sat_models_inter_inj, symmetric])


lemma prop_equiv_subset:
  "{abs_ltlnP ψ |ψ. nested_prop_atoms ψ ⊆ P} ⊆ {abs_ltlnP ψ |ψ. prop_atoms ψ ⊆ P}"
  using prop_atoms_nested_prop_atoms by blast

lemma prop_equiv_finite':
  "finite P ⟹ finite {abs_ltlnP ψ | ψ. nested_prop_atoms ψ ⊆ P}"
  using prop_equiv_finite prop_equiv_subset finite_subset by fast

lemma prop_equiv_card':
  "finite P ⟹ card {abs_ltlnP ψ | ψ. nested_prop_atoms ψ ⊆ P} ≤ 2 ^ 2 ^ card P"
  by (metis (mono_tags, lifting) prop_equiv_card prop_equiv_subset prop_equiv_finite card_mono le_trans)



subsection ‹Substitution›

fun subst :: "'a ltln ⇒ ('a ltln ⇀ 'a ltln) ⇒ 'a ltln"
where
  "subst truen m = truen"
| "subst falsen m = falsen"
| "subst (φ andn ψ) m = subst φ m andn subst ψ m"
| "subst (φ orn ψ) m = subst φ m orn subst ψ m"
| "subst φ m = (case m φ of Some ψ ⇒ ψ | None ⇒ φ)"

text ‹Based on Uwe Schoening's Translation Lemma (Logic for CS, p. 54)›

lemma ltl_prop_equiv_subst_S:
  "S ⊨P subst φ m = ((S - dom m) ∪ {χ | χ χ'. χ ∈ dom m ∧ m χ = Some χ' ∧ S ⊨P χ'}) ⊨P φ"
  by (induction φ) (auto split: option.split)

lemma subst_respects_ltl_prop_entailment:
  "φ ⟶P ψ ⟹ subst φ m ⟶P subst ψ m"
  "φ ∼P ψ ⟹ subst φ m ∼P subst ψ m"
  unfolding ltl_prop_equiv_def ltl_prop_implies_def ltl_prop_equiv_subst_S by blast+


lemma eval_subst:
  "eval φ = Yes ⟹ eval (subst φ m) = Yes"
  "eval φ = No ⟹ eval (subst φ m) = No"
  by (meson empty_subsetI eval_prop_entailment ltl_prop_entailment_monotonI ltl_prop_equiv_subst_S subset_UNIV)+

lemma subst_respects_ltl_const_entailment:
  "φ ∼C ψ ⟹ subst φ m ∼C subst ψ m"
  unfolding ltl_const_equiv_def
  by (cases "eval ψ") (metis eval_subst(1), metis eval_subst(2), blast)



subsection ‹Order of Equivalence Relations›

locale ltl_equivalence =
  fixes
    eq :: "'a ltln ⇒ 'a ltln ⇒ bool" (infix "∼" 75)
  assumes
    eq_equivp: "equivp (∼)"
  and
    ge_const_equiv: "(∼C) ≤ (∼)"
  and
    le_lang_equiv: "(∼) ≤ (∼L)"
begin

lemma eq_implies_ltl_equiv:
  "φ ∼ ψ ⟹ w ⊨n φ = w ⊨n ψ"
  using le_lang_equiv ltl_lang_equiv_def by blast

lemma const_implies_eq:
  "φ ∼C ψ ⟹ φ ∼ ψ"
  using ge_const_equiv by blast

lemma eq_implies_lang:
  "φ ∼ ψ ⟹ φ ∼L ψ"
  using le_lang_equiv by blast

lemma eq_refl[simp]:
  "φ ∼ φ"
  by (meson eq_equivp equivp_reflp)

lemma eq_sym[sym]:
  "φ ∼ ψ ⟹ ψ ∼ φ"
  by (meson eq_equivp equivp_symp)

lemma eq_trans[trans]:
  "φ ∼ ψ ⟹ ψ ∼ χ ⟹ φ ∼ χ"
  by (meson eq_equivp equivp_transp)

end

interpretation ltl_lang_equivalence: ltl_equivalence "(∼L)"
  using ltl_lang_equiv_equivp ltl_const_equiv_lt_ltl_prop_equiv ltl_prop_equiv_lt_ltl_lang_equiv
  by unfold_locales blast+

interpretation ltl_prop_equivalence: ltl_equivalence "(∼P)"
  using ltl_prop_equiv_equivp ltl_const_equiv_lt_ltl_prop_equiv ltl_prop_equiv_lt_ltl_lang_equiv
  by unfold_locales blast+

interpretation ltl_const_equivalence: ltl_equivalence "(∼C)"
  using ltl_const_equiv_equivp ltl_const_equiv_lt_ltl_prop_equiv ltl_prop_equiv_lt_ltl_lang_equiv
  by unfold_locales blast+

end