header{* Pseudo-Hoops *}

theory PseudoHoops
imports RightComplementedMonoid
begin

lemma drop_assumption:
  "p \<Longrightarrow> True"
  by simp

class pseudo_hoop_algebra = left_complemented_monoid_algebra + right_complemented_monoid_nole_algebra +
  assumes left_right_impl_times: "(a l\<rightarrow> b) * a = a * (a r\<rightarrow> b)"
begin
  definition
    "inf_rr a b  = a * (a r\<rightarrow> b)"

  definition
    "lesseq_r a b = (a r\<rightarrow> b = 1)"

  definition
    "less_r a b = (lesseq_r a b \<and> \<not> lesseq_r b a)"
end

(*
sublocale pseudo_hoop_algebra < right!: right_complemented_monoid_algebra lesseq_r less_r 1 "op *" inf_rr "op r\<rightarrow>";
  apply unfold_locales;
  apply simp_all;
  apply (simp add: less_r_def);
  apply (simp add: inf_rr_def);
  apply (rule right_impl_times, rule right_impl_ded);
  by (simp add: lesseq_r_def);
*)

context pseudo_hoop_algebra begin

  lemma inf_rr_inf [simp]: "inf_rr = op \<sqinter>"
    by (unfold fun_eq_iff, simp add: inf_rr_def inf_l_def left_right_impl_times)

  lemma lesseq_lesseq_r: "lesseq_r a b = (a \<le> b)"
  proof -
    interpret A!: right_complemented_monoid_algebra lesseq_r less_r 1 "op *" inf_rr "op r\<rightarrow>"
      by (rule right_complemented_monoid_algebra)
(*
    find_theorems name: le_iff_inf
    thm A.dual_algebra.le_iff_inf
    have "\<And>x y. lesseq_r x y = (inf_rr x y = x)" by fact
    note `\<And>x y. lesseq_r x y = (inf_rr x y = x)`
*)
    show "lesseq_r a b = (a \<le> b)"
      apply (subst  le_iff_inf)
      apply (subst `lesseq_r a b = (inf_rr a b = a)`)
      apply (unfold inf_rr_inf [THEN sym])
      by simp
  qed

  lemma [simp]: "less_r = op <"
    by (unfold fun_eq_iff, simp add: less_r_def less_le_not_le)

  subclass right_complemented_monoid_algebra
    apply (cut_tac right_complemented_monoid_algebra)
    by simp
  end

sublocale pseudo_hoop_algebra <
     pseudo_hoop_dual!: pseudo_hoop_algebra "\<lambda> a b . b * a" "op \<sqinter>" "op r\<rightarrow>" "op \<le>" "op <" 1 "op l\<rightarrow>"
  apply unfold_locales
  apply (simp add: inf_l_def)
  apply simp
  apply (simp add: left_impl_times)
  apply (simp add: left_impl_ded)
  by (simp add: left_right_impl_times)

context pseudo_hoop_algebra begin
lemma commutative_ps: "(\<forall> a b . a * b = b * a) = ((op l\<rightarrow>) = (op r\<rightarrow>))"
  apply (simp add: fun_eq_iff)
  apply safe
  apply (rule antisym)
  apply (simp add: right_residual [THEN sym])
  apply (subgoal_tac "x * (x l\<rightarrow> xa) =  (x l\<rightarrow> xa) * x")
  apply (drule drop_assumption)
  apply simp
  apply (simp add: left_residual)
  apply simp
  apply (simp add: left_residual [THEN sym])
  apply (simp add: right_residual)
  apply (rule antisym)
  apply (simp add: left_residual)
  apply (simp add: right_residual [THEN sym])
  apply (simp add: left_residual)
  by (simp add: right_residual [THEN sym])

lemma lemma_2_4_5: "a l\<rightarrow> b \<le> (c l\<rightarrow> a) l\<rightarrow> (c l\<rightarrow> b)"
  apply (simp add: left_residual [THEN sym] mult.assoc)
  apply (rule_tac y = "(a l\<rightarrow> b) * a" in order_trans)
  apply (rule mult_left_mono)
  by (simp_all add: left_residual)

end

context pseudo_hoop_algebra begin

lemma lemma_2_4_6: "a r\<rightarrow> b \<le> (c r\<rightarrow> a) r\<rightarrow> (c r\<rightarrow> b)"
  by (rule pseudo_hoop_dual.lemma_2_4_5)

primrec
  imp_power_l:: "'a => nat \<Rightarrow> 'a \<Rightarrow> 'a" ("(_) l-(_)\<rightarrow> (_)" [65,0,65] 65) where
   "a l-0\<rightarrow> b = b" |
   "a l-(Suc n)\<rightarrow> b = (a l\<rightarrow> (a l-n\<rightarrow> b))"

primrec
  imp_power_r:: "'a => nat \<Rightarrow> 'a \<Rightarrow> 'a" ("(_) r-(_)\<rightarrow> (_)" [65,0,65] 65) where
   "a r-0\<rightarrow> b = b" |
   "a r-(Suc n)\<rightarrow> b = (a r\<rightarrow> (a r-n\<rightarrow> b))"

lemma lemma_2_4_7_a: "a l-n\<rightarrow> b = a ^ n l\<rightarrow> b"
  apply (induct_tac n)
  by (simp_all add: left_impl_ded)

lemma lemma_2_4_7_b: "a r-n\<rightarrow> b = a ^ n r\<rightarrow> b"
  apply (induct_tac n)
  by (simp_all add: right_impl_ded [THEN sym] power_commutes)

lemma lemma_2_5_8_a [simp]: "a * b \<le> a"
  by (rule dual_algebra.H)

lemma lemma_2_5_8_b [simp]: "a * b \<le> b"
  by (rule H)

lemma lemma_2_5_9_a: "a \<le> b l\<rightarrow> a"
  by (simp add: left_residual [THEN sym] dual_algebra.H)

lemma lemma_2_5_9_b: "a \<le> b r\<rightarrow> a"
  by (simp add: right_residual [THEN sym] H)

lemma lemma_2_5_11: "a * b \<le> a \<sqinter> b"
  by simp

lemma lemma_2_5_12_a: "a \<le> b \<Longrightarrow>  c l\<rightarrow> a \<le> c l\<rightarrow> b"
  apply (subst left_residual [THEN sym])
  apply (subst left_impl_times)
  apply (rule_tac y = "(a l\<rightarrow> c) * b" in order_trans)
  apply (simp add: mult_left_mono)
  by (rule H)

lemma lemma_2_5_13_a: "a \<le> b \<Longrightarrow>  b l\<rightarrow> c \<le> a l\<rightarrow> c"
  apply (simp add: left_residual [THEN sym])
  apply (rule_tac y = "(b l\<rightarrow> c) * b" in order_trans)
  apply (simp add: mult_left_mono)
  by (simp add: left_residual)

lemma lemma_2_5_14: "(b l\<rightarrow> c) * (a l\<rightarrow> b) \<le> a l\<rightarrow> c"
  apply (simp add: left_residual [THEN sym])
  apply (simp add: mult.assoc)
  apply (subst left_impl_times)
  apply (subst mult.assoc [THEN sym])
  apply (subst left_residual)
  by (rule dual_algebra.H)

lemma lemma_2_5_16: "(a l\<rightarrow> b) \<le>  (b l\<rightarrow> c) r\<rightarrow> (a l\<rightarrow> c)"
  apply (simp add: right_residual [THEN sym])
  by (rule lemma_2_5_14)

lemma lemma_2_5_18: "(a l\<rightarrow> b) \<le>  a * c l\<rightarrow> b * c"
  apply (simp add: left_residual  [THEN sym])
  apply (subst mult.assoc  [THEN sym])
  apply (rule mult_right_mono)
  apply (subst left_impl_times)
  by (rule H)

end

context pseudo_hoop_algebra begin

lemma lemma_2_5_12_b: "a \<le> b \<Longrightarrow>  c r\<rightarrow> a \<le> c r\<rightarrow> b"
  by (rule pseudo_hoop_dual.lemma_2_5_12_a)

lemma lemma_2_5_13_b: "a \<le> b \<Longrightarrow>  b r\<rightarrow> c \<le> a r\<rightarrow> c"
  by (rule pseudo_hoop_dual.lemma_2_5_13_a)

lemma lemma_2_5_15: "(a r\<rightarrow> b) * (b r\<rightarrow> c) \<le> a r\<rightarrow> c"
  by (rule pseudo_hoop_dual.lemma_2_5_14)

lemma lemma_2_5_17: "(a r\<rightarrow> b) \<le>  (b r\<rightarrow> c) l\<rightarrow> (a r\<rightarrow> c)"
  by (rule pseudo_hoop_dual.lemma_2_5_16)

lemma lemma_2_5_19: "(a r\<rightarrow> b) \<le>  c * a r\<rightarrow> c * b"
  by (rule pseudo_hoop_dual.lemma_2_5_18)

definition
  "lower_bound A = {a . \<forall> x \<in> A . a \<le> x}"

definition
  "infimum A = {a \<in> lower_bound A . (\<forall> x \<in> lower_bound A . x \<le> a)}"

lemma infimum_unique: "(infimum A = {x}) = (x \<in> infimum A)"
  apply safe
  apply simp
  apply (rule antisym)
  by (simp_all add: infimum_def)

lemma lemma_2_6_20:
  "a \<in> infimum A \<Longrightarrow> b l\<rightarrow> a \<in> infimum ((op l\<rightarrow> b)`A)"
  apply (subst infimum_def)
  apply safe
  apply (simp add: infimum_def lower_bound_def lemma_2_5_12_a)
  by (simp add: infimum_def lower_bound_def left_residual  [THEN sym])

end

context pseudo_hoop_algebra begin

lemma lemma_2_6_21:
  "a \<in> infimum A \<Longrightarrow> b r\<rightarrow> a \<in> infimum ((op r\<rightarrow> b)`A)"
  by (rule pseudo_hoop_dual.lemma_2_6_20)

lemma infimum_pair: "a \<in> infimum {x . x = b \<or> x = c} = (a = b \<sqinter> c)"
  apply (simp add: infimum_def lower_bound_def)
  apply safe
  apply (rule antisym)
  by simp_all

lemma lemma_2_6_20_a:
  "a l\<rightarrow> (b \<sqinter> c) = (a l\<rightarrow> b) \<sqinter> (a l\<rightarrow> c)"
  apply (subgoal_tac "b \<sqinter> c \<in> infimum {x . x = b \<or> x = c}")
  apply (drule_tac b = a in lemma_2_6_20)
  apply (case_tac "(op l\<rightarrow> a) ` {x . ((x = b) \<or> (x = c))} = {x . x = a l\<rightarrow> b \<or> x = a l\<rightarrow> c}")
  apply (simp_all add: infimum_pair)
  by auto
end

context pseudo_hoop_algebra begin

lemma lemma_2_6_21_a:
  "a r\<rightarrow> (b \<sqinter> c) = (a r\<rightarrow> b) \<sqinter> (a r\<rightarrow> c)"
  by (rule pseudo_hoop_dual.lemma_2_6_20_a)

lemma mult_mono: "a \<le> b \<Longrightarrow> c \<le> d \<Longrightarrow> a * c \<le> b * d"
  apply (rule_tac y = "a * d" in order_trans)
  by (simp_all add: mult_right_mono mult_left_mono)

lemma lemma_2_7_22: "(a l\<rightarrow> b) * (c l\<rightarrow> d) \<le> (a \<sqinter> c) l\<rightarrow> (b \<sqinter> d)"
  apply (rule_tac y = "(a \<sqinter> c l\<rightarrow> b) * (a \<sqinter> c l\<rightarrow> d)" in order_trans)
  apply (rule mult_mono)
  apply (simp_all add: lemma_2_5_13_a)
  apply (rule_tac y = "(a \<sqinter> c l\<rightarrow> b) \<sqinter> (a \<sqinter> c l\<rightarrow> d)" in order_trans)
  apply (rule lemma_2_5_11)
  by (simp add: lemma_2_6_20_a)

end

context pseudo_hoop_algebra begin
lemma lemma_2_7_23: "(a r\<rightarrow> b) * (c r\<rightarrow> d) \<le> (a \<sqinter> c) r\<rightarrow> (b \<sqinter> d)"
  apply (rule_tac y = "(c \<sqinter> a) r\<rightarrow> (d \<sqinter> b)" in order_trans)
  apply (rule pseudo_hoop_dual.lemma_2_7_22)
  by (simp add: inf_commute)

definition
  "upper_bound A = {a . \<forall> x \<in> A . x \<le> a}"

definition
  "supremum A = {a \<in> upper_bound A . (\<forall> x \<in> upper_bound A . a \<le> x)}"

lemma supremum_unique:
  "a \<in> supremum A \<Longrightarrow> b \<in> supremum A \<Longrightarrow> a = b"
  apply (simp add: supremum_def upper_bound_def)
  apply (rule antisym)
  by auto

lemma lemma_2_8_i:
  "a \<in> supremum A \<Longrightarrow> a l\<rightarrow> b \<in> infimum ((\<lambda> x . x l\<rightarrow> b)`A)"
  apply (subst infimum_def)
  apply safe
  apply (simp add: supremum_def upper_bound_def lower_bound_def lemma_2_5_13_a)
  apply (simp add: supremum_def upper_bound_def lower_bound_def left_residual  [THEN sym])
  by (simp add: right_residual)

end

context pseudo_hoop_algebra begin

lemma lemma_2_8_i1:
  "a \<in> supremum A \<Longrightarrow> a r\<rightarrow> b \<in> infimum ((\<lambda> x . x r\<rightarrow> b)`A)"
  by (rule pseudo_hoop_dual.lemma_2_8_i, simp)

definition
  times_set :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a set"  (infixl "**" 70) where
  "(A ** B) = {a . \<exists> x \<in> A . \<exists> y \<in> B . a = x * y}"

lemma times_set_assoc: "A ** (B ** C) = (A ** B) ** C"
  apply (simp add: times_set_def)
  apply safe
  apply (rule_tac x = "xa * xb" in exI)
  apply safe
  apply (rule_tac x = xa in bexI)
  apply (rule_tac x = xb in bexI)
  apply simp_all
  apply (subst mult.assoc)
  apply (rule_tac x = ya in bexI)
  apply simp_all
  apply (rule_tac x = xb in bexI)
  apply simp_all
  apply (rule_tac x = "ya * y" in exI)
  apply (subst mult.assoc)
  apply simp
  by auto

primrec power_set :: "'a set \<Rightarrow> nat \<Rightarrow> 'a set" (infixr "*^" 80) where
    power_set_0: "(A *^ 0) = {1}"
  | power_set_Suc: "(A *^ (Suc n)) = (A ** (A *^ n))"

lemma infimum_singleton [simp]: "infimum {a} = {a}"
  apply (simp add: infimum_def lower_bound_def)
  by auto

lemma lemma_2_8_ii:
  "a \<in> supremum A \<Longrightarrow> (a ^ n) l\<rightarrow> b \<in> infimum ((\<lambda> x . x l\<rightarrow> b)`(A *^ n))"
  apply (induct_tac n)
  apply simp
  apply (simp add: left_impl_ded)
  apply (drule_tac a = "a ^ n l\<rightarrow> b" and b = a in lemma_2_6_20)
  apply (simp add: infimum_def lower_bound_def times_set_def)
  apply safe
  apply (drule_tac b = "y l\<rightarrow> b" in lemma_2_8_i)
  apply (simp add: infimum_def lower_bound_def times_set_def left_impl_ded)
  apply (rule_tac y = "a l\<rightarrow> y l\<rightarrow> b" in order_trans)
  apply simp_all
  apply (subgoal_tac "(\<forall>xa \<in> A *^ n. x \<le> a l\<rightarrow> xa l\<rightarrow> b)")
  apply simp
  apply safe
  apply (drule_tac b = "xa l\<rightarrow> b" in lemma_2_8_i)
  apply (simp add: infimum_def lower_bound_def)
  apply safe
  apply (subgoal_tac "(\<forall>xb \<in> A. x \<le> xb l\<rightarrow> xa l\<rightarrow> b)")
  apply simp
  apply safe
  apply (subgoal_tac "x \<le> xb * xa l\<rightarrow> b")
  apply (simp add: left_impl_ded)
  apply (subgoal_tac "(\<exists>x \<in> A. \<exists>y \<in> A *^ n. xb * xa = x * y)")
  by auto

lemma power_set_Suc2:
  "A *^ (Suc n) = A *^ n ** A"
  apply (induct_tac n)
  apply (simp add: times_set_def)
  apply simp
  apply (subst times_set_assoc)
  by simp

lemma power_set_add:
  "A *^ (n + m) = (A *^ n) ** (A *^ m)"
  apply (induct_tac m)
  apply simp
  apply (simp add: times_set_def)
  apply simp
  apply (subst times_set_assoc)
  apply (subst times_set_assoc)
  apply (subst power_set_Suc2 [THEN sym])
  by simp
end

context pseudo_hoop_algebra begin

lemma lemma_2_8_ii1:
  "a \<in> supremum A \<Longrightarrow> (a ^ n) r\<rightarrow> b \<in> infimum ((\<lambda> x . x r\<rightarrow> b)`(A *^ n))"
  apply (induct_tac n)
  apply simp
  apply (subst power_Suc2)
  apply (subst power_set_Suc2)
  apply (simp add: right_impl_ded)
  apply (drule_tac a = "a ^ n r\<rightarrow> b" and b = a in lemma_2_6_21)
  apply (simp add: infimum_def lower_bound_def times_set_def)
  apply safe
  apply (drule_tac b = "xa r\<rightarrow> b" in lemma_2_8_i1)
  apply (simp add: infimum_def lower_bound_def times_set_def right_impl_ded)
  apply (rule_tac y = "a r\<rightarrow> xa r\<rightarrow> b" in order_trans)
  apply simp_all
  apply (subgoal_tac "(\<forall>xa \<in> A *^ n. x \<le> a r\<rightarrow> xa r\<rightarrow> b)")
  apply simp
  apply safe
  apply (drule_tac b = "xa r\<rightarrow> b" in lemma_2_8_i1)
  apply (simp add: infimum_def lower_bound_def)
  apply safe
  apply (subgoal_tac "(\<forall>xb \<in> A. x \<le> xb r\<rightarrow> xa r\<rightarrow> b)")
  apply simp
  apply safe
  apply (subgoal_tac "x \<le> xa * xb r\<rightarrow> b")
  apply (simp add: right_impl_ded)
  apply (subgoal_tac "(\<exists>x \<in> A *^ n. \<exists>y \<in> A . xa * xb = x * y)")
  by auto

lemma lemma_2_9_i:
  "b \<in> supremum A \<Longrightarrow> a * b \<in> supremum (op * a ` A)"
  apply (simp add: supremum_def upper_bound_def)
  apply safe
  apply (simp add: mult_left_mono)
  by (simp add: right_residual)

lemma lemma_2_9_i1:
  "b \<in> supremum A \<Longrightarrow> b * a \<in> supremum ((\<lambda> x . x * a) ` A)"
  apply (simp add: supremum_def upper_bound_def)
  apply safe
  apply (simp add: mult_right_mono)
  by (simp add: left_residual)

lemma lemma_2_9_ii:
  "b \<in> supremum A \<Longrightarrow> a \<sqinter> b \<in> supremum (op \<sqinter> a ` A)"
  apply (subst supremum_def)
  apply safe
  apply (simp add: supremum_def upper_bound_def)
  apply safe
  apply (rule_tac y = x in order_trans)
  apply simp_all
  apply (subst inf_commute)
  apply (subst inf_l_def)
  apply (subst left_right_impl_times)
  apply (frule_tac a = "(b r\<rightarrow> a)" in lemma_2_9_i1)
  apply (simp add: right_residual)
  apply (simp add: supremum_def upper_bound_def)
  apply (simp add: right_residual)
  apply safe
  apply (subgoal_tac "(\<forall>xa \<in> A. b r\<rightarrow> a \<le> xa r\<rightarrow> x)")
  apply simp
  apply safe
  apply (simp add: inf_l_def)
  apply (simp add: left_right_impl_times)
  apply (rule_tac y = "xa r\<rightarrow>  b * (b r\<rightarrow> a)" in order_trans)
  apply simp
  apply (rule lemma_2_5_12_b)
  apply (subst left_residual)
  apply (subgoal_tac "(\<forall>xa\<in>A. xa \<le> (b r\<rightarrow> a) l\<rightarrow> x)")
  apply simp
  apply safe
  apply (subst left_residual [THEN sym])
  apply (rule_tac y = "xaa * (xaa r\<rightarrow> a)" in order_trans)
  apply (rule mult_left_mono)
  apply (rule lemma_2_5_13_b)
  apply simp
  apply (subst right_impl_times)
  by simp

lemma lemma_2_10_24:
  "a \<le> (a l\<rightarrow> b) r\<rightarrow> b"
  by (simp add: right_residual [THEN sym] inf_l_def [THEN sym])

lemma lemma_2_10_25:
  "a \<le> (a l\<rightarrow> b) r\<rightarrow> a"
  by (rule lemma_2_5_9_b)
end

context pseudo_hoop_algebra begin
lemma lemma_2_10_26:
  "a \<le> (a r\<rightarrow> b) l\<rightarrow> b"
  by (rule pseudo_hoop_dual.lemma_2_10_24)

lemma lemma_2_10_27:
  "a \<le> (a r\<rightarrow> b) l\<rightarrow> a"
  by (rule lemma_2_5_9_a)

lemma lemma_2_10_28:
  "b l\<rightarrow> ((a l\<rightarrow> b) r\<rightarrow> a) = b l\<rightarrow> a"
  apply (rule antisym)
  apply (subst left_residual [THEN sym])
  apply (rule_tac y = "((a l\<rightarrow> b) r\<rightarrow> a) \<sqinter> a" in order_trans)
  apply (subst inf_l_def)
  apply (rule_tac y = "(((a l\<rightarrow> b) r\<rightarrow> a) l\<rightarrow> b) * ((a l\<rightarrow> b) r\<rightarrow> a)" in order_trans)
  apply (subst left_impl_times)
  apply simp_all
  apply (rule mult_right_mono)
  apply (rule_tac y = "a l\<rightarrow> b" in order_trans)
  apply (rule lemma_2_5_13_a)
  apply (fact lemma_2_10_25)
  apply (fact lemma_2_10_26)
  apply (rule lemma_2_5_12_a)
  by (fact lemma_2_10_25)

end

context pseudo_hoop_algebra begin

lemma lemma_2_10_29:
  "b r\<rightarrow> ((a r\<rightarrow> b) l\<rightarrow> a) = b r\<rightarrow> a"
  by (rule pseudo_hoop_dual.lemma_2_10_28)

lemma lemma_2_10_30:
  "((b l\<rightarrow> a) r\<rightarrow> a) l\<rightarrow> a = b l\<rightarrow> a"
  apply (rule antisym)
  apply (simp_all add: lemma_2_10_26)
  apply (rule lemma_2_5_13_a)
  by (rule lemma_2_10_24)

end

context pseudo_hoop_algebra begin

lemma lemma_2_10_31:
  "((b r\<rightarrow> a) l\<rightarrow> a) r\<rightarrow> a = b r\<rightarrow> a"
  by (rule pseudo_hoop_dual.lemma_2_10_30)

lemma lemma_2_10_32:
  "(((b l\<rightarrow> a) r\<rightarrow> a) l\<rightarrow> b) l\<rightarrow> (b l\<rightarrow> a) = b l\<rightarrow> a"
  proof -
    have "((((b l\<rightarrow> a) r\<rightarrow> a) l\<rightarrow> b) l\<rightarrow> (b l\<rightarrow> a) = (((b l\<rightarrow> a) r\<rightarrow> a) l\<rightarrow> b) l\<rightarrow> (((b l\<rightarrow> a) r\<rightarrow> a) l\<rightarrow> a))"
      by (simp add: lemma_2_10_30)
    also have "\<dots> = ((((b l\<rightarrow> a) r\<rightarrow> a) l\<rightarrow> b) * ((b l\<rightarrow> a) r\<rightarrow> a) l\<rightarrow> a)"
      by (simp add: left_impl_ded)
    also have "\<dots> = (((b l\<rightarrow> a) r\<rightarrow> a) \<sqinter> b) l\<rightarrow> a"
      by (simp add: inf_l_def)
    also have "\<dots> = b l\<rightarrow> a" apply (subgoal_tac "((b l\<rightarrow> a) r\<rightarrow> a) \<sqinter> b = b", simp, rule antisym)
      by (simp_all add: lemma_2_10_24)
    finally show ?thesis .
  qed

end

context pseudo_hoop_algebra begin

lemma lemma_2_10_33:
  "(((b r\<rightarrow> a) l\<rightarrow> a) r\<rightarrow> b) r\<rightarrow> (b r\<rightarrow> a) = b r\<rightarrow> a"
  by (rule pseudo_hoop_dual.lemma_2_10_32)
end

class pseudo_hoop_sup_algebra = pseudo_hoop_algebra + sup +
  assumes
    sup_comute: "a \<squnion> b = b \<squnion> a"
    and sup_le [simp]: "a \<le> a \<squnion> b"
    and le_sup_equiv: "(a \<le> b) = (a \<squnion> b = b)"
begin
  lemma sup_le_2 [simp]:
    "b \<le> a \<squnion> b"
    by (subst sup_comute, simp)

  lemma le_sup_equiv_r:
    "(a \<squnion> b = b) = (a \<le> b)"
    by (simp add: le_sup_equiv)

  lemma sup_idemp [simp]:
    "a \<squnion> a = a"
    by (simp add: le_sup_equiv_r)
end

class pseudo_hoop_sup1_algebra = pseudo_hoop_algebra + sup +
  assumes
  sup_def: "a \<squnion> b = ((a l\<rightarrow> b) r\<rightarrow> b) \<sqinter> ((b l\<rightarrow> a) r\<rightarrow> a)"
begin

lemma sup_comute1: "a \<squnion> b = b \<squnion> a"
  apply (simp add: sup_def)
  apply (rule antisym)
  by simp_all

lemma sup_le1 [simp]: "a \<le> a \<squnion> b"
  by (simp add: sup_def lemma_2_10_24 lemma_2_5_9_b)

lemma le_sup_equiv1: "(a \<le> b) = (a \<squnion> b = b)"
  apply safe
  apply (simp add: left_lesseq)
  apply (rule antisym)
  apply (simp add: sup_def)
  apply (simp add: sup_def)
  apply (simp_all add: lemma_2_10_24)
  apply (simp add:  le_iff_inf)
  apply (subgoal_tac "(a \<sqinter> b = a \<sqinter> (a \<squnion> b)) \<and> (a \<sqinter> (a \<squnion> b) = a)")
  apply simp
  apply safe
  apply simp
  apply (rule antisym)
  apply simp
  apply (drule drop_assumption)
  by (simp add: sup_comute1)

subclass pseudo_hoop_sup_algebra
  apply unfold_locales
  apply (simp add: sup_comute1)
  apply simp
  by (simp add: le_sup_equiv1)
end

class pseudo_hoop_sup2_algebra = pseudo_hoop_algebra + sup +
  assumes
  sup_2_def: "a \<squnion> b = ((a r\<rightarrow> b) l\<rightarrow> b) \<sqinter> ((b r\<rightarrow> a) l\<rightarrow> a)"

context pseudo_hoop_sup1_algebra begin end

sublocale pseudo_hoop_sup2_algebra < sup1_dual!: pseudo_hoop_sup1_algebra "op \<squnion>" "\<lambda> a b . b * a" "op \<sqinter>" "op r\<rightarrow>" "op \<le>" "op <" 1 "op l\<rightarrow>"
  apply unfold_locales
  by (simp add: sup_2_def)

context pseudo_hoop_sup2_algebra begin

lemma sup_comute_2: "a \<squnion> b = b \<squnion> a"
  by (rule  sup1_dual.sup_comute)

lemma sup_le2 [simp]: "a \<le> a \<squnion> b"
  by (rule sup1_dual.sup_le)

lemma le_sup_equiv2: "(a \<le> b) = (a \<squnion> b = b)"
  by (rule sup1_dual.le_sup_equiv)

subclass pseudo_hoop_sup_algebra
  apply unfold_locales
  apply (simp add: sup_comute_2)
  apply simp
  by (simp add: le_sup_equiv2)

end

class pseudo_hoop_lattice_a = pseudo_hoop_sup_algebra +
  assumes sup_inf_le_distr: "a \<squnion> (b \<sqinter> c) \<le> (a \<squnion> b) \<sqinter> (a \<squnion> c)"
begin
  lemma sup_lower_upper_bound [simp]:
    "a \<le> c \<Longrightarrow> b \<le> c \<Longrightarrow> a \<squnion> b \<le> c"
    apply (subst le_iff_inf)
    apply (subgoal_tac "(a \<squnion> b) \<sqinter> c = (a \<squnion> b) \<sqinter> (a \<squnion> c) \<and> a \<squnion> (b \<sqinter> c) \<le> (a \<squnion> b) \<sqinter> (a \<squnion> c) \<and> a \<squnion> (b \<sqinter> c) = a \<squnion> b")
    apply (rule antisym)
    apply simp
    apply safe
    apply auto[1]
    apply (simp add:  le_sup_equiv)
    apply (rule sup_inf_le_distr)
    by (simp add: le_iff_inf)
end

sublocale pseudo_hoop_lattice_a <  lattice "op \<sqinter>" "op \<le>" "op <" "op \<squnion>"
  by (unfold_locales, simp_all)

class pseudo_hoop_lattice_b = pseudo_hoop_sup_algebra +
  assumes le_sup_cong: "a \<le> b \<Longrightarrow> a \<squnion> c \<le> b \<squnion> c"

begin
  lemma sup_lower_upper_bound_b [simp]:
    "a \<le> c \<Longrightarrow> b \<le> c \<Longrightarrow> a \<squnion> b \<le> c"
    proof -
      assume A: "a \<le> c"
      assume B: "b \<le> c"
      have "a \<squnion> b \<le> c \<squnion> b" by (cut_tac A, simp add: le_sup_cong)
      also have "\<dots> = b \<squnion> c" by (simp add: sup_comute)
      also have "\<dots> \<le> c \<squnion> c" by (cut_tac B, rule le_sup_cong, simp)
      also have "\<dots> = c"  by simp
      finally show ?thesis .
    qed

  lemma  sup_inf_le_distr_b:
    "a \<squnion> (b \<sqinter> c) \<le> (a \<squnion> b) \<sqinter> (a \<squnion> c)"
    apply (rule sup_lower_upper_bound_b)
    apply simp
    apply simp
    apply safe
    apply (subst sup_comute)
    apply (rule_tac y = "b" in order_trans)
    apply simp_all
    apply (rule_tac y = "c" in order_trans)
    by simp_all
end

context pseudo_hoop_lattice_a begin end

sublocale pseudo_hoop_lattice_b <  pseudo_hoop_lattice_a "op \<squnion>" "op *" "op \<sqinter>" "op l\<rightarrow>" "op \<le>" "op <" 1 "op r\<rightarrow>"
  by (unfold_locales, rule sup_inf_le_distr_b)

class pseudo_hoop_lattice = pseudo_hoop_sup_algebra +
  assumes sup_assoc_1: "a \<squnion> (b \<squnion> c) = (a \<squnion> b) \<squnion> c"
begin
  lemma le_sup_cong_c:
    "a \<le> b \<Longrightarrow> a \<squnion> c \<le> b \<squnion> c"
    proof -
      assume A: "a \<le> b"
      have "a \<squnion> c \<squnion> (b \<squnion> c) = a \<squnion> (c \<squnion> (b \<squnion> c))" by (simp add: sup_assoc_1)
      also have "\<dots> = a \<squnion> ((b \<squnion> c) \<squnion> c)" by (simp add: sup_comute)
      also have "\<dots> = a \<squnion> (b \<squnion> (c \<squnion> c))" by (simp add: sup_assoc_1 [THEN sym])
      also have "\<dots> = (a \<squnion> b) \<squnion> c" by (simp add: sup_assoc_1)
      also have "\<dots> = b \<squnion> c" by (cut_tac A, simp add: le_sup_equiv)
      finally show ?thesis by (simp add: le_sup_equiv)
    qed
end

sublocale pseudo_hoop_lattice <  pseudo_hoop_lattice_b "op \<squnion>" "op *" "op \<sqinter>" "op l\<rightarrow>" "op \<le>" "op <" 1 "op r\<rightarrow>"
  by (unfold_locales, rule le_sup_cong_c)

sublocale pseudo_hoop_lattice <  semilattice_sup "op \<squnion>" "op \<le>" "op <"
  by (unfold_locales, simp_all)

sublocale pseudo_hoop_lattice <  lattice "op \<sqinter>" "op \<le>" "op <" "op \<squnion>"
  by unfold_locales

lemma (in pseudo_hoop_lattice_a) supremum_pair [simp]:
  "supremum {a, b} = {a \<squnion> b}"
  apply (simp add: supremum_def upper_bound_def)
  apply safe
  apply simp_all
  apply (rule antisym)
  by simp_all

sublocale pseudo_hoop_lattice <  distrib_lattice "op \<sqinter>" "op \<le>" "op <" "op \<squnion>"
  apply unfold_locales
  apply (rule distrib_imp1)
  apply (case_tac "xa \<sqinter> (ya \<squnion> za) \<in> supremum (op \<sqinter> xa ` {ya, za})")
  apply (simp add: supremum_pair)
  apply (erule notE)
  apply (rule lemma_2_9_ii)
  by (simp add: supremum_pair)

class bounded_semilattice_inf_top = semilattice_inf + order_top
begin
lemma inf_eq_top_iff [simp]:
  "(inf x y = top) = (x = top \<and> y = top)"
  by (simp add: eq_iff)
end

sublocale pseudo_hoop_algebra < bounded_semilattice_inf_top "op \<sqinter>" "op \<le>" "op <" "1"
  by unfold_locales simp

definition (in pseudo_hoop_algebra)
  sup1::"'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "\<squnion>1" 70) where
  "a \<squnion>1 b = ((a l\<rightarrow> b) r\<rightarrow> b) \<sqinter> ((b l\<rightarrow> a) r\<rightarrow> a)"

sublocale pseudo_hoop_algebra < sup1!: pseudo_hoop_sup1_algebra "op \<squnion>1" "op *" "op \<sqinter>" "op l\<rightarrow>" "op \<le>" "op <" 1 "op r\<rightarrow>"
  apply unfold_locales
  by (simp add: sup1_def)

definition (in pseudo_hoop_algebra)
  sup2::"'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "\<squnion>2" 70) where
  "a \<squnion>2 b = ((a r\<rightarrow> b) l\<rightarrow> b) \<sqinter> ((b r\<rightarrow> a) l\<rightarrow> a)"

sublocale pseudo_hoop_algebra < sup2!: pseudo_hoop_sup2_algebra "op \<squnion>2" "op *" "op \<sqinter>" "op l\<rightarrow>" "op \<le>" "op <" 1 "op r\<rightarrow>"
  apply unfold_locales
  by (simp add: sup2_def)

context pseudo_hoop_algebra
begin
  lemma lemma_2_15_i:
    "1 \<in> supremum {a, b} \<Longrightarrow> a * b = a \<sqinter> b"
    apply (rule antisym)
    apply (rule lemma_2_5_11)
    apply (simp add: inf_l_def)
    apply (subst left_impl_times)
    apply (rule mult_right_mono)
    apply (subst right_lesseq)
    apply (subgoal_tac "a \<squnion>1 b = 1")
    apply (simp add: sup1_def)
    apply (rule antisym)
    apply simp
    by (simp add: supremum_def upper_bound_def)

  lemma lemma_2_15_ii:
    "1 \<in> supremum {a, b} \<Longrightarrow> a \<le> c \<Longrightarrow> b \<le> d \<Longrightarrow> 1 \<in> supremum {c, d}"
    apply (simp add: supremum_def upper_bound_def)
    apply safe
    apply (drule_tac x = x in spec)
    apply safe
    by simp_all

lemma sup_union:
  "a \<in> supremum A \<Longrightarrow> b \<in> supremum B \<Longrightarrow> supremum {a, b} = supremum (A \<union> B)"
  apply safe
  apply (simp_all add: supremum_def upper_bound_def)
  apply safe
  apply auto
  apply (subgoal_tac "(\<forall>x \<in> A \<union> B. x \<le> xa)")
  by auto

lemma sup_singleton [simp]: "a \<in> supremum {a}"
  by (simp add: supremum_def upper_bound_def)

lemma sup_union_singleton: "a \<in> supremum X \<Longrightarrow> supremum {a, b} = supremum (X \<union> {b})"
  apply (rule_tac B = "{b}" in  sup_union)
  by simp_all

lemma sup_le_union [simp]: "a \<le> b \<Longrightarrow> supremum (A \<union> {a, b}) = supremum (A \<union> {b})"
  apply (simp add: supremum_def upper_bound_def)
  by auto

lemma sup_sup_union: "a \<in> supremum A \<Longrightarrow> b \<in> supremum (B \<union> {a}) \<Longrightarrow> b \<in> supremum (A \<union> B)"
  apply (simp add: supremum_def upper_bound_def)
  by auto

end

(*
context monoid_mult
begin
lemma "a ^ 2 = a * a"
  by (simp add: local.power2_eq_square)
end
*)

lemma [simp]:
  "n \<le> 2 ^ n"
  apply (induct_tac n)
  apply auto
  apply (rule_tac y = "1 + 2 ^ n" in order_trans)
  by auto

context pseudo_hoop_algebra
begin

lemma sup_le_union_2:
  "a \<le> b \<Longrightarrow> a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> supremum A = supremum ((A - {a}) \<union> {b})"
  apply (case_tac "supremum ((A - {a , b}) \<union> {a, b}) = supremum ((A - {a, b}) \<union> {b})")
  apply (case_tac "((A - {a, b}) \<union> {a, b} = A) \<and> ((A - {a, b}) \<union> {b} = (A - {a}) \<union> {b})")
  apply safe[1]
  apply simp
  apply simp
  apply (erule notE)
  apply safe [1]
  apply (erule notE)
  apply (rule sup_le_union)
  by simp

  lemma lemma_2_15_iii_0:
    "1 \<in> supremum {a, b} \<Longrightarrow> 1 \<in> supremum {a ^ 2, b ^ 2}"
    apply (frule_tac a = a in lemma_2_9_i)
    apply simp
    apply (frule_tac a = a and b = b in sup_union_singleton)
    apply (subgoal_tac "supremum ({a * a, a * b} \<union> {b}) = supremum ({a * a, b})")
    apply simp_all
    apply (frule_tac a = b in lemma_2_9_i)
    apply simp
    apply (drule_tac a = b and A = "{b * (a * a), b * b}" and b = 1 and B = "{a * a}" in sup_sup_union)
    apply simp
    apply (case_tac "{a * a, b} = {b, a * a}")
    apply simp
    apply auto [1]
    apply simp
    apply (subgoal_tac "supremum {a * a, b * (a * a), b * b} = supremum {a * a, b * b}")
    apply(simp add: power2_eq_square)
    apply (case_tac "b * (a * a) = b * b")
    apply auto[1]
    apply (cut_tac  A = "{a * a, b * (a * a), b * b}" and a = "b * (a * a)" and b = "a * a" in  sup_le_union_2)
    apply simp
    apply simp
    apply simp
    apply (subgoal_tac "({a * a, b * (a * a), b * b} - {b * (a * a)} \<union> {a * a}) = {a * a, b * b}")
    apply simp
    apply auto[1]
    apply (case_tac "a * a = a * b")
    apply (subgoal_tac "{b, a * a, a * b} = {a * a, b}")
    apply simp
    apply auto[1]
    apply (cut_tac  A = "{b, a * a, a * b}" and a = "a * b" and b = "b" in  sup_le_union_2)
    apply simp
    apply simp
    apply simp
    apply (subgoal_tac "{b, a * a, a * b} - {a * b} \<union> {b} = {a * a, b}")
    apply simp
    by auto

lemma [simp]: "m \<le> n \<Longrightarrow> a ^ n \<le> a ^ m"
  apply (subgoal_tac "a ^ n = (a ^ m) * (a ^ (n-m))")
  apply simp
  apply (cut_tac a = a and m = "m" and n = "n - m" in power_add)
  by simp

lemma [simp]: "a ^ (2 ^ n) \<le> a ^ n"
  by simp

lemma lemma_2_15_iii_1: "1 \<in> supremum {a, b} \<Longrightarrow> 1 \<in> supremum {a ^ (2 ^ n), b ^ (2 ^ n)}"
  apply (induct_tac n)
  apply auto[1]
  apply (drule drop_assumption)
  apply (drule lemma_2_15_iii_0)
  apply (subgoal_tac "!a . (a ^ (2\<Colon>nat) ^ n)\<^sup>2 = a ^ (2\<Colon>nat) ^ Suc n")
  apply simp
  apply safe
  apply (cut_tac a = aa and m = "2 ^ n" and n = 2 in  power_mult)
  apply auto
  apply (subgoal_tac "((2\<Colon>nat) ^ n * (2\<Colon>nat)) = ((2\<Colon>nat) * (2\<Colon>nat) ^ n)")
  by simp_all

  lemma lemma_2_15_iii:
    "1 \<in> supremum {a, b} \<Longrightarrow> 1 \<in> supremum {a ^ n, b ^ n}"
    apply (drule_tac n = n in lemma_2_15_iii_1)
    apply (simp add: supremum_def upper_bound_def)
    apply safe
    apply (drule_tac x = x in spec)
    apply safe
    apply (rule_tac y = "a ^ n" in order_trans)
    apply simp_all
    apply (rule_tac y = "b ^ n" in order_trans)
    by simp_all
end

end


theory (*calc_name_core*)
imports Main "~~/src/HOL/Library/Code_Char" "~~/src/HOL/Code_Numeral" (*always keep Code_char import last! its added for code generator to output Haskell strings instead of the isabelle nibble stuff *)
begin

(*calc_structure*)

class Varmatch =
  (* match takes a string occurring in a pattern and a term and returns the string
     with a matching subterm. Never returns a list longer than 1. *)
  fixes "match" :: "'a \<Rightarrow> 'a \<Rightarrow> ('a * 'a) list"
  fixes "freevars" :: "'a \<Rightarrow> 'a set"
  (* first argument matches return-type of match *)
  fixes "replace" :: "('a * 'a) \<Rightarrow> 'a \<Rightarrow> 'a"

definition m_clash :: "'a \<times> 'b \<Rightarrow> ('a \<times> 'b) list \<Rightarrow> bool" (infix "\<inter>m" 400) where
"x \<inter>m y \<equiv> \<exists>a \<in> set y. fst a = fst x \<and> snd a \<noteq> snd x"

lemma m_clash_simp[simp] : "set (map fst m1) \<inter> set (map fst m2) = {} \<longrightarrow> (\<forall>x \<in> set m1. \<not>(x \<inter>m m2))"
unfolding m_clash_def by auto

fun merge :: "('a * 'b) list \<Rightarrow> ('a * 'b) list  \<Rightarrow> ('a * 'b) list " (infix "@m" 400) where
"[] @m y = y" |
"(x#xs) @m y = ( if x \<inter>m y
                 then [a \<leftarrow> xs. fst a \<noteq> fst x] @m [a \<leftarrow> y . fst a \<noteq> fst x]
                 else x#(xs @m y) )"

lemma merge_simp[simp] :
  fixes m1 m2
  assumes "(\<forall>a\<in>set m1. case a of (x, y) \<Rightarrow> x = y)"
  and "\<forall>a\<in>set m2. case a of (x, y) \<Rightarrow> x = y"
  shows "set (m1 @m m2) = set m1 \<union> set m2"
using assms(1)
proof (induct m1)
  case Nil
    show ?case by simp
next
  case (Cons x xs)
    have "\<forall>a\<in>set xs. case a of (a, b) \<Rightarrow> a = b"
      by (metis Cons.prems(1) contra_subsetD set_subset_Cons)
    with Cons(1) have 1: "set (xs @m m2) = set xs \<union> set m2" by simp
    { assume "\<not>(x \<inter>m m2)"
      then have "set ((x # xs) @m m2) = set (x#xs @m m2)" by simp
      with 1 have ?case by simp }
    { assume "(x \<inter>m m2)"
      then have "\<exists>a \<in> set m2. fst a = fst x \<and> snd a \<noteq> snd x" unfolding m_clash_def by simp
      then obtain a where 2: "a \<in> set m2" and 3: "fst a = fst x" and 4: "snd a \<noteq> snd x" by auto
      then have False by (metis (full_types) Cons.prems(1) assms(2) fst_conv insertI1 old.prod.exhaust set_simps(2) snd_eqD split_beta)
      then have ?case .. }
    thus ?case
      by (metis `\<not> x \<inter>m m2 \<Longrightarrow> set ((x # xs) @m m2) = set (x # xs) \<union> set m2`)
qed

lemma merge_simp2[simp] :
  fixes m1 m2
  assumes "set (map fst m1) \<inter> set (map fst m2) = {}"
  shows "set (m1 @m m2) = set m1 \<union> set m2"
using assms
proof (induct m1)
case Nil
  show ?case by simp
next
case (Cons x xs)
  then have "set (map fst xs) \<inter> set (map fst m2) = {}" by simp
  with Cons(1) have 1: "set (xs @m m2) = set xs \<union> set m2" by simp
  with Cons(2) have "\<not>(x \<inter>m m2)" by (metis insertCI m_clash_simp set_simps(2))
  then have "set ((x # xs) @m m2) = set( x#(xs @m m2) )" by simp
  then have "set ((x # xs) @m m2) = set(xs @m m2) \<union> {x}" by simp
  with 1 have "set ((x # xs) @m m2) = set xs \<union> set m2 \<union> {x}" by simp
  thus ?case by simp
qed

fun(in Varmatch) replaceAll :: "('a * 'a) list \<Rightarrow> 'a \<Rightarrow> 'a"
where
  "replaceAll Nil mtch = mtch"
| "replaceAll (x # xs) mtch = replaceAll xs (replace x mtch)"

lemma replaceAll_simp: "(replaceAll [(x, r)] m) \<equiv> (replace (x, r) m)" by auto

definition(in Varmatch) ruleMatch :: "'a \<Rightarrow> 'a \<Rightarrow> bool" where
"ruleMatch r m = (if freevars m = {} then (replaceAll (match r m) r) = m else False)"

(*lemma(in Varmatch) ruleMatch_simp[simp]: "freevars m = {} \<longrightarrow> ruleMatch r m \<equiv> (replaceAll (match r m) r) = m"*)

class Varmatch_preserving = Varmatch +
  assumes inv: "a = (replaceAll (match a a) a)"

(*(*uncommentL?Atprop*)
instantiation Atprop :: Varmatch
begin
  primrec match_Atprop :: "Atprop \<Rightarrow> Atprop \<Rightarrow> (Atprop * Atprop) list"
  where
    "match_Atprop (Atprop_Freevar free) x = [((Atprop_Freevar free), x)]" |
    "match_Atprop (Atprop _) _ = []"

  primrec freevars_Atprop :: "Atprop \<Rightarrow> Atprop set"
  where
    "freevars_Atprop (Atprop_Freevar var) = {(Atprop_Freevar var)}" |
    "freevars_Atprop (Atprop _) = {}"

  primrec replace_Atprop_aux :: "Atprop \<Rightarrow> Atprop \<Rightarrow> Atprop \<Rightarrow> Atprop"
  where
    "replace_Atprop_aux (Atprop_Freevar a) mtch x = (case x of (Atprop_Freevar free) \<Rightarrow> (if a = free then mtch else (Atprop_Freevar free)) | _ \<Rightarrow> x)" |
    "replace_Atprop_aux (Atprop a) mtch x = x"
  primrec replace_Atprop :: "(Atprop * Atprop) \<Rightarrow> Atprop \<Rightarrow> Atprop"
  where
    "replace_Atprop (a,b) c = replace_Atprop_aux a b c"

instance ..
end
(*uncommentR?Atprop*)*)

(*(*uncommentL?Action*)
instantiation Action :: Varmatch
begin
  fun match_Action :: "Action \<Rightarrow> Action \<Rightarrow> (Action * Action) list"
  where
    "match_Action (Action_Freevar free) mtch = [((Action_Freevar free), mtch)]" |
    "match_Action _ _ = []"

  fun freevars_Action :: "Action \<Rightarrow> Action set"
  where
    "freevars_Action (Action_Freevar var) = {(Action_Freevar var)}" |
    "freevars_Action _ = {}"

  fun replace_Action :: "(Action * Action) \<Rightarrow> Action \<Rightarrow> Action"
  where
    "replace_Action ((Action_Freevar x), mtch) (Action_Freevar free) = (if x = free then mtch else (Action_Freevar free))" |
    "replace_Action _ pttrn = pttrn"
instance ..
end
(*uncommentR?Action*)*)

(*(*uncommentL?Agent*)
instantiation Agent :: Varmatch
begin
  fun match_Agent :: "Agent \<Rightarrow> Agent \<Rightarrow> (Agent * Agent) list"
  where
    "match_Agent (Agent_Freevar free) mtch = [((Agent_Freevar free), mtch)]" |
    "match_Agent _ _ = []"

  fun freevars_Agent :: "Agent \<Rightarrow> Agent set"
  where
    "freevars_Agent (Agent_Freevar var) = {(Agent_Freevar var)}" |
    "freevars_Agent _ = {}"

  fun replace_Agent :: "(Agent * Agent) \<Rightarrow> Agent \<Rightarrow> Agent"
  where
    "replace_Agent ((Agent_Freevar x), mtch) (Agent_Freevar free) = (if x = free then mtch else (Agent_Freevar free))" |
    "replace_Agent _ pttrn = pttrn"
instance ..
end
(*uncommentR?Agent*)*)

(*(*uncommentL?Formula*)
instantiation Formula :: Varmatch
begin
  primrec match_Formula :: "Formula \<Rightarrow> Formula \<Rightarrow> (Formula * Formula) list"
  where
(*(*uncommentL?Formula_Atprop*)  "match_Formula (Formula_Atprop rule) x = (case x of (Formula_Atprop m) \<Rightarrow> map (\<lambda>(x,y). (Formula_Atprop x, Formula_Atprop y)) (match rule m) | _ \<Rightarrow> [])" (*uncommentR?Formula_Atprop*)*)
(*(*uncommentL?Formula_Bin*)  | "match_Formula (Formula_Bin var11 op1 var12) x = (case x of (Formula_Bin var21 op2 var22) \<Rightarrow> (if op1 = op2 then (match var11 var21) @m (match var12 var22) else []) | _ \<Rightarrow> [])" (*uncommentR?Formula_Bin*)*)
(*(*uncommentL?Formula_Un*)  | "match_Formula (Formula_Un op1 var1) x = (case x of (Formula_Un op2 var2) \<Rightarrow> (if op1 = op2 then (match var1 var2) else []) | _ \<Rightarrow> [])" (*uncommentR?Formula_Un*)*)

(*(*uncommentL?Formula_Freevar*)  | "match_Formula (Formula_Freevar free) x = [((Formula_Freevar free), x)]" (*uncommentR?Formula_Freevar*)*)
(*(*uncommentL?Formula_Action_Formula*)  | "match_Formula (Formula_Action_Formula op1 act1 form1) x = (case x of (Formula_Action_Formula op2 act2 form2) \<Rightarrow> (if op1 = op2 then map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match act1 act2) @m (match form1 form2) else []) | _ \<Rightarrow> [])" (*uncommentR?Formula_Action_Formula*)*)
(*(*uncommentL?Formula_Agent_Formula*)  | "match_Formula (Formula_Agent_Formula op1 act1 form1) x = (case x of (Formula_Agent_Formula op2 act2 form2) \<Rightarrow> (if op1 = op2 then map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match act1 act2) @m (match form1 form2) else []) | _ \<Rightarrow> [])" (*uncommentR?Formula_Agent_Formula*)*)
(*(*uncommentL?Formula_Precondition*)  | "match_Formula (Formula_Precondition act1) x = (case x of (Formula_Precondition act2) \<Rightarrow> map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match act1 act2) | _ \<Rightarrow> [])" (*uncommentR?Formula_Precondition*)*)
(*(*uncommentL?Formula_Zer*)  | "match_Formula (Formula_Zer z) x = []" (*uncommentR?Formula_Zer*)*)
(*(*uncommentL?Formula_Agent*)  | "match_Formula (Formula_Agent z) x = []" (*uncommentR?Formula_Agent*)*)
(*(*uncommentL?Formula_Action*)  | "match_Formula (Formula_Action z) x = []" (*uncommentR?Formula_Action*)*)

  primrec freevars_Formula :: "Formula \<Rightarrow> Formula set"
  where
(*(*uncommentL?Formula_Atprop*)   "freevars_Formula (Formula_Atprop var) = image (\<lambda>x. Formula_Atprop x) (freevars var)" (*uncommentR?Formula_Atprop*)*)
(*(*uncommentL?Formula_Bin*)  | "freevars_Formula (Formula_Bin var1 _ var2) = (freevars var1) \<union> (freevars var2)" (*uncommentR?Formula_Bin*)*)
(*(*uncommentL?Formula_Un*)  | "freevars_Formula (Formula_Un  _ var) = freevars var" (*uncommentR?Formula_Un*)*)

(*(*uncommentL?Formula_Freevar*)  | "freevars_Formula (Formula_Freevar var) = {(Formula_Freevar var)}" (*uncommentR?Formula_Freevar*)*)

(*(*uncommentL?Formula_Action_Formula*)  | "freevars_Formula (Formula_Action_Formula _ act1 form1) = image (\<lambda>x. Formula_Action x) (freevars act1) \<union> (freevars form1)" (*uncommentR?Formula_Action_Formula*)*)
(*(*uncommentL?Formula_Agent_Formula*)  | "freevars_Formula (Formula_Agent_Formula _ ag1 form1) = image (\<lambda>x. Formula_Agent x) (freevars ag1) \<union> (freevars form1)" (*uncommentR?Formula_Agent_Formula*)*)
(*(*uncommentL?Formula_Precondition*)  | "freevars_Formula (Formula_Precondition act1) = image (\<lambda>x. Formula_Action x) (freevars act1)" (*uncommentR?Formula_Precondition*)*)
(*(*uncommentL?Formula_Zer*)  | "freevars_Formula (Formula_Zer act1) = {}" (*uncommentR?Formula_Zer*)*)
(*(*uncommentL?Formula_Agent*)  | "freevars_Formula (Formula_Agent ag1) = {(Formula_Freevar ''ag'')}" (*uncommentR?Formula_Agent*)*)
(*(*uncommentL?Formula_Action*)  | "freevars_Formula (Formula_Action act1) = {(Formula_Freevar ''act'')}" (*uncommentR?Formula_Action*)*)

  primrec replace_Formula_aux :: "Formula \<Rightarrow> Formula \<Rightarrow> Formula \<Rightarrow> Formula"
  where
(*(*uncommentL?Formula_Atprop*)    "replace_Formula_aux x mtch (Formula_Atprop a) = (case x of (Formula_Atprop xa) \<Rightarrow> (case mtch of (Formula_Atprop mtcha) \<Rightarrow> Formula_Atprop (replace (xa, mtcha) a) | _ \<Rightarrow> (Formula_Atprop a)) | _ \<Rightarrow> (Formula_Atprop a))" (*uncommentR?Formula_Atprop*)*)
(*(*uncommentL?Formula_Bin*)  | "replace_Formula_aux x mtch (Formula_Bin var1 op1 var2) = Formula_Bin (replace_Formula_aux x mtch var1) op1 (replace_Formula_aux x mtch var2)" (*uncommentR?Formula_Bin*)*)
(*(*uncommentL?Formula_Un*)  | "replace_Formula_aux x mtch (Formula_Un op1 var) = Formula_Un op1 (replace_Formula_aux x mtch var)" (*uncommentR?Formula_Un*)*)
(*(*uncommentL?Formula_Freevar*)  | "replace_Formula_aux x mtch (Formula_Freevar free) = (if x = (Formula_Freevar free) then mtch else (Formula_Freevar free))" (*uncommentR?Formula_Freevar*)*)

(*(*uncommentL?Formula_Action_Formula*)  | "replace_Formula_aux x mtch (Formula_Action_Formula op1 act1 form1) =
      (case x of (Formula_Action xa) \<Rightarrow>
        (case mtch of (Formula_Action mtcha) \<Rightarrow> Formula_Action_Formula op1 (replace (xa, mtcha) act1) (replace_Formula_aux x mtch form1) |
        _ \<Rightarrow> Formula_Action_Formula op1 act1 (replace_Formula_aux x mtch form1) ) |
      _ \<Rightarrow> Formula_Action_Formula op1 act1 (replace_Formula_aux x mtch form1) )" (*uncommentR?Formula_Action_Formula*)*)
(*(*uncommentL?Formula_Agent_Formula*)  | "replace_Formula_aux x mtch (Formula_Agent_Formula op1 act1 form1) =
      (case x of (Formula_Agent xa) \<Rightarrow>
        (case mtch of (Formula_Agent mtcha) \<Rightarrow> Formula_Agent_Formula op1 (replace (xa, mtcha) act1) (replace_Formula_aux x mtch form1) |
        _ \<Rightarrow> Formula_Agent_Formula op1 act1 (replace_Formula_aux x mtch form1) ) |
      _ \<Rightarrow> Formula_Agent_Formula op1 act1 (replace_Formula_aux x mtch form1) )" (*uncommentR?Formula_Agent_Formula*)*)
(*(*uncommentL?Formula_Precondition*)  | "replace_Formula_aux x mtch (Formula_Precondition act1) =
      (case x of (Formula_Action xa) \<Rightarrow>
        (case mtch of (Formula_Action mtcha) \<Rightarrow> Formula_Precondition (replace (xa, mtcha) act1) |
        _ \<Rightarrow> (Formula_Precondition act1) ) |
      _ \<Rightarrow> (Formula_Precondition act1) )" (*uncommentR?Formula_Precondition*)*)
(*(*uncommentL?Formula_Zer*)  | "replace_Formula_aux x mtch (Formula_Zer z) = (Formula_Zer z)" (*uncommentR?Formula_Zer*)*)
(*(*uncommentL?Formula_Agent*)  | "replace_Formula_aux x mtch (Formula_Agent z) = (Formula_Agent z)" (*uncommentR?Formula_Agent*)*)
(*(*uncommentL?Formula_Action*)  | "replace_Formula_aux x mtch (Formula_Action z) = (Formula_Action z)" (*uncommentR?Formula_Action*)*)

  primrec replace_Formula :: "(Formula * Formula) \<Rightarrow> Formula \<Rightarrow> Formula"
  where
  "replace_Formula (a,b) c = replace_Formula_aux a b c"

instance ..
end
(*uncommentR?Formula*)*)

(*(*uncommentL?Structure*)
instantiation Structure :: Varmatch
begin
  primrec match_Structure :: "Structure \<Rightarrow> Structure \<Rightarrow> (Structure * Structure) list"
  where
(*(*uncommentL?Structure_Formula*)  "match_Structure (Structure_Formula rule) x = (case x of (Structure_Formula form) \<Rightarrow> map (\<lambda>(x,y). (Structure_Formula x, Structure_Formula y)) (match rule form) | _ \<Rightarrow> [])" (*uncommentR?Structure_Formula*)*)
(*(*uncommentL?Structure_Bin*) | "match_Structure (Structure_Bin var11 op1 var12) x = (case x of (Structure_Bin var21 op2 var22) \<Rightarrow> (if op1 = op2 then (match var11 var21) @m (match var12 var22) else []) | _ \<Rightarrow> [])" (*uncommentR?Structure_Bin*)*)
(*(*uncommentL?Structure_Freevar*) | "match_Structure (Structure_Freevar free) x = [((Structure_Freevar free), x)]" (*uncommentR?Structure_Freevar*)*)
(*(*uncommentL?Structure_Action_Structure*) | "match_Structure (Structure_Action_Structure op1 act1 struct1) x = (case x of (Structure_Action_Structure op2 act2 struct2) \<Rightarrow> (if op1 = op2 then map (\<lambda>(x,y). (Structure_Formula (Formula_Action x), Structure_Formula (Formula_Action y))) (match act1 act2) @m (match struct1 struct2) else []) |  _ \<Rightarrow> [])" (*uncommentR?Structure_Action_Structure*)*)
(*(*uncommentL?Structure_Agent_Structure*) | "match_Structure (Structure_Agent_Structure op1 act1 struct1) x = (case x of (Structure_Agent_Structure op2 act2 struct2) \<Rightarrow> (if op1 = op2 then map (\<lambda>(x,y). (Structure_Formula (Formula_Agent x), Structure_Formula (Formula_Agent y))) (match act1 act2) @m (match struct1 struct2) else []) |  _ \<Rightarrow> [])" (*uncommentR?Structure_Agent_Structure*)*)
(*(*uncommentL?Structure_Phi*) | "match_Structure (Structure_Phi act1) x = (case x of (Structure_Phi act2) \<Rightarrow> map (\<lambda>(x,y). (Structure_Formula (Formula_Action x), Structure_Formula (Formula_Action y))) (match act1 act2) |  _ \<Rightarrow> [])"  (*uncommentR?Structure_Phi*)*)
(*(*uncommentL?Structure_Zer*) | "match_Structure (Structure_Zer _) x = []" (*uncommentR?Structure_Zer*)*)
(*(*uncommentL?Structure_Bigcomma*) | "match_Structure (Structure_Bigcomma list) x = []" (*uncommentR?Structure_Bigcomma*)*)

  fun freevars_Structure :: "Structure \<Rightarrow> Structure set"
  where
(*(*uncommentL?Structure_Formula*)  "freevars_Structure (Structure_Formula var) = image (\<lambda>x. Structure_Formula x) (freevars var)"(*uncommentR?Structure_Formula*)*)
(*(*uncommentL?Structure_Bin*) | "freevars_Structure (Structure_Bin var1 _ var2) = (freevars var1) \<union> (freevars var2)"(*uncommentR?Structure_Bin*)*)
(*(*uncommentL?Structure_Freevar*) | "freevars_Structure (Structure_Freevar var) = {(Structure_Freevar var)}"(*uncommentR?Structure_Freevar*)*)
(*(*uncommentL?Structure_Action_Structure*) | "freevars_Structure (Structure_Action_Structure _ act1 struct) = image (\<lambda>x. Structure_Formula (Formula_Action x)) (freevars act1) \<union> (freevars struct)"(*uncommentR?Structure_Action_Structure*)*)
(*(*uncommentL?Structure_Agent_Structure*) | "freevars_Structure (Structure_Agent_Structure _ ag1 struct) = image (\<lambda>x. Structure_Formula (Formula_Agent x)) (freevars ag1) \<union> (freevars struct)" (*uncommentR?Structure_Agent_Structure*)*)
(*(*uncommentL?Structure_Phi*) | "freevars_Structure (Structure_Phi act1) = image (\<lambda>x. Structure_Formula (Formula_Action x)) (freevars act1)" (*uncommentR?Structure_Phi*)*)
(*(*uncommentL?Structure_Bigcomma*) | "freevars_Structure (Structure_Bigcomma list) = foldr (op \<union>) (map freevars list) {}" (*uncommentR?Structure_Bigcomma*)*)
(*(*uncommentL?Structure_Zer*)  | "freevars_Structure (Structure_Zer _) = {}" (*uncommentR?Structure_Zer*)*)

  primrec replace_Structure_aux :: "Structure \<Rightarrow> Structure \<Rightarrow> Structure \<Rightarrow> Structure" (*(*uncommentL?Structure_Bigcomma*)and replace_Structure_list_aux :: "Structure \<Rightarrow> Structure \<Rightarrow> Structure list \<Rightarrow> Structure list"(*uncommentR?Structure_Bigcomma*)*)
  where
(*(*uncommentL?Structure_Formula*)     "replace_Structure_aux x mtch (Structure_Formula f) = (case x of (Structure_Formula xf) \<Rightarrow> (case mtch of (Structure_Formula mtchf) \<Rightarrow> Structure_Formula (replace (xf, mtchf) f) | _ \<Rightarrow> (Structure_Formula f)) | _ \<Rightarrow> (Structure_Formula f))" (*uncommentR?Structure_Formula*)*)
(*(*uncommentL?Structure_Bin*)  | "replace_Structure_aux x mtch (Structure_Bin var1 op1 var2) = Structure_Bin (replace_Structure_aux x mtch var1) op1 (replace_Structure_aux x mtch var2)" (*uncommentR?Structure_Formula*)*)
(*(*uncommentL?Structure_Freevar*)  | "replace_Structure_aux x mtch (Structure_Freevar free) = (if x = (Structure_Freevar free) then mtch else (Structure_Freevar free))" (*uncommentR?Structure_Freevar*)*)
(*(*uncommentL?Structure_Action_Structure*)  | "replace_Structure_aux x mtch (Structure_Action_Structure op1 act1 form1) =
      (case x of (Structure_Formula (Formula_Action xa)) \<Rightarrow>
        (case mtch of (Structure_Formula (Formula_Action mtcha)) \<Rightarrow> Structure_Action_Structure op1 (replace (xa, mtcha) act1) (replace_Structure_aux x mtch form1) |
        _ \<Rightarrow> Structure_Action_Structure op1 act1 (replace_Structure_aux x mtch form1) ) |
      _ \<Rightarrow> Structure_Action_Structure op1 act1 (replace_Structure_aux x mtch form1) )" (*uncommentR?Structure_Action_Structure*)*)
(*(*uncommentL?Structure_Agent_Structure*)  | "replace_Structure_aux x mtch (Structure_Agent_Structure op1 act1 form1) =
      (case x of (Structure_Formula (Formula_Agent xa)) \<Rightarrow>
        (case mtch of (Structure_Formula (Formula_Agent mtcha)) \<Rightarrow> Structure_Agent_Structure op1 (replace (xa, mtcha) act1) (replace_Structure_aux x mtch form1) |
        _ \<Rightarrow> Structure_Agent_Structure op1 act1 (replace_Structure_aux x mtch form1) ) |
      _ \<Rightarrow> Structure_Agent_Structure op1 act1 (replace_Structure_aux x mtch form1) )" (*uncommentR?Structure_Agent_Structure*)*)
(*(*uncommentL?Structure_Phi*)  | "replace_Structure_aux x mtch (Structure_Phi act1) =
      (case x of (Structure_Formula (Formula_Action xa)) \<Rightarrow>
        (case mtch of (Structure_Formula (Formula_Action mtcha)) \<Rightarrow> Structure_Phi (replace (xa, mtcha) act1) |
        _ \<Rightarrow> (Structure_Phi act1) ) |
      _ \<Rightarrow> (Structure_Phi act1) )" (*uncommentR?Structure_Phi*)*)
(*(*uncommentL?Structure_Zer*)  | "replace_Structure_aux x mtch (Structure_Zer z) = (Structure_Zer z)" (*uncommentR?Structure_Zer*)*)
(*(*uncommentL?Structure_Bigcomma*)  | "replace_Structure_aux x mtch (Structure_Bigcomma list) = Structure_Bigcomma (replace_Structure_list_aux x mtch list)"
  | "replace_Structure_list_aux x mtch [] = []"
  | "replace_Structure_list_aux x mtch (l#ist) = (replace_Structure_aux x mtch l)#(replace_Structure_list_aux x mtch ist)"
(*uncommentR?Structure_Bigcomma*)*)

primrec replace_Structure :: "(Structure * Structure) \<Rightarrow> Structure \<Rightarrow> Structure"
  where
  "replace_Structure (a,b) c = replace_Structure_aux a b c"

instance ..
end
(*uncommentR?Structure*)*)

(*(*uncommentL?Sequent*)
instantiation Sequent :: Varmatch
begin
  fun match_Sequent :: "Sequent \<Rightarrow> Sequent \<Rightarrow> (Sequent * Sequent) list"
  where
    "match_Sequent (Sequent var11 var12) (Sequent var21 var22) = (map (\<lambda>(x,y). (Sequent_Structure x, Sequent_Structure y)) ((match var11 var21) @m (match var12 var22)))"
  | "match_Sequent _ _ = []"

  fun freevars_Sequent :: "Sequent \<Rightarrow> Sequent set"
  where
    "freevars_Sequent (Sequent var1 var2) = image (\<lambda>x. Sequent_Structure x) (freevars var1 \<union> freevars var2)"
  | "freevars_Sequent _ = {}"

  fun replace_Sequent :: "(Sequent * Sequent) \<Rightarrow> Sequent \<Rightarrow> Sequent"
  where
    "replace_Sequent ((Sequent_Structure x), (Sequent_Structure rep))  (Sequent var1 var2) = Sequent (replace (x, rep) var1) (replace (x, rep) var2)"
  | "replace_Sequent (_, _) y = y"
instance ..
end
(*uncommentR?Sequent*)*)

(*(*uncommentL?Atprop*)
lemma inv_Atprop[simp]:
  fixes a::Atprop
  assumes "free \<in> set (match a a)"
  shows "a = replace free a"
apply(cases a)
apply (metis assms empty_iff match_Atprop.simps(2) set_empty)
apply(cases free, case_tac aa, auto, case_tac b, auto)
apply (metis Atprop.distinct(2) assms in_set_insert insert_Nil match_Atprop.simps(1) not_Cons_self prod.inject set_ConsD swap_simp)
by (metis Atprop.distinct(2) Atprop.exhaust Atprop.inject(2) assms in_set_insert insert_Nil match_Atprop.simps(1) not_Cons_self old.prod.exhaust prod.inject set_ConsD)

lemma inv_Atprop_2[simp]:
  fixes a::Atprop
  shows "a = replaceAll (match a a) a"
by (cases a, metis match_Atprop.simps(2) replaceAll.simps(1), simp)

lemma freevars_replace_Atprop_simp[simp]: "free \<notin> freevars (a::Atprop) \<longrightarrow> replace (free,free) a = a"
apply(cases free)
apply auto
apply (induct a)
apply auto
done
(* metis Atprop.exhaust replace_Atprop.simps(1) replace_Atprop.simps(2) *)

lemma freevars_replace_Atprop_simp2 : "free \<in> freevars (a::Atprop) \<longrightarrow> replace (free,free) a = a"
by (induct a) (cases free, auto)

lemma match_Atprop_simp : "\<forall>(x, y) \<in> set (match (a::Atprop) a). x = y"
by (cases a) auto
(*uncommentR?Atprop*)*)

(*(*uncommentL?Action*)
lemma inv_Action[simp]:
  fixes a::Action
  assumes "free \<in> set (match a a)"
  shows "a = replace free a"
by (cases a, metis replace_Action.simps(3))
(metis assms in_set_insert insert_Nil match_Action.simps(1) not_Cons_self2 replace_Action.simps(1) set_ConsD)

lemma inv_Action_2[simp]:
  fixes a::Action
  shows "a = replaceAll (match a a) a"
by (cases a, metis match_Action.simps(2) replaceAll.simps(1), simp)

lemma freevars_replace_Action_simp[simp]: "free \<notin> freevars (a::Action) \<longrightarrow> replace (free,free) a = a"
by (induct a) (cases free, auto, metis Action.exhaust replace_Action.simps(1) replace_Action.simps(2))

lemma freevars_replace_Action_simp2 : "free \<in> freevars (a::Action) \<longrightarrow> replace (free,free) a = a"
by (induct a) (cases free, auto)

lemma match_Action_simp : "\<forall>(x, y) \<in> set (match (a::Action) a). x = y"
by (cases a) auto

(*uncommentR?Action*)*)

(*(*uncommentL?Agent*)
lemma inv_Agent[simp]:
  fixes a::Agent
  assumes "free \<in> set (match a a)"
  shows "a = replace free a"
by (cases a, metis replace_Agent.simps(3))
(metis assms in_set_insert insert_Nil match_Agent.simps(1) not_Cons_self2 replace_Agent.simps(1) set_ConsD)

lemma inv_Agent_2[simp]:
  fixes a::Agent
  shows "a = replaceAll (match a a) a"
by (cases a, metis match_Agent.simps(2) replaceAll.simps(1), simp)

lemma freevars_replace_Agent_simp[simp]: "free \<notin> freevars (a::Agent) \<longrightarrow> replace (free,free) a = a"
by (induct a) (cases free, auto, metis Agent.exhaust replace_Agent.simps(1) replace_Agent.simps(2))

lemma freevars_replace_Agent_simp2 : "free \<in> freevars (a::Agent) \<longrightarrow> replace (free,free) a = a"
by (induct a) (cases free, auto)

lemma match_Agent_simp : "\<forall>(x, y) \<in> set (match (a::Agent) a). x = y"
by (cases a) auto

(*uncommentR?Agent*)*)

(*(*uncommentL?Formula*)
lemma freevars_replace_Formula_simp[simp]: "free \<notin> freevars (a::Formula) \<longrightarrow> replace (free,free) a = a"
proof (induct a)
(*(*uncommentL?Formula_Atprop*)
  case (Formula_Atprop x) thus ?case
apply(cases x)
apply(cases free)
apply auto
apply (metis freevars_replace_Atprop_simp freevars_replace_Atprop_simp2 replace_Atprop.simps)
apply(cases free)
apply auto
apply (metis freevars_replace_Atprop_simp freevars_replace_Atprop_simp2 replace_Atprop.simps)
done
next
(*uncommentR?Formula_Atprop*)*)
(*(*uncommentL?Formula_Freevar*)
  case (Formula_Freevar x) thus ?case by simp
next
(*uncommentR?Formula_Freevar*)*)
(*(*uncommentL?Formula_Zer*)
  case (Formula_Zer x) thus ?case by simp
next
(*uncommentR?Formula_Zer*)*)
(*(*uncommentL?Formula_Bin*)
  case (Formula_Bin x c y) thus ?case by simp
next
(*uncommentR?Formula_Bin*)*)
(*(*uncommentL?Formula_Un*)
  case (Formula_Un c x) thus ?case by simp
next
(*uncommentR?Formula_Un*)*)
(*(*uncommentL?Formula_Action*)
  case (Formula_Action x) thus ?case by simp
next
(*uncommentR?Formula_Action*)*)
(*(*uncommentL?Formula_Agent*)
  case (Formula_Agent x) thus ?case by simp
next
(*uncommentR?Formula_Agent*)*)
(*(*uncommentL?Formula_Precondition*)
  case (Formula_Precondition x) thus ?case
apply(cases x)
apply(cases free)
apply auto
apply(cases free)
apply auto
done
next
(*uncommentR?Formula_Precondition*)*)
(*(*uncommentL?Formula_Action_Formula*)
  case (Formula_Action_Formula c x y) thus ?case
apply(cases x)
apply(cases free)
apply auto
apply(cases free)
apply auto
done
next
(*uncommentR?Formula_Action_Formula*)*)
(*(*uncommentL?Formula_Agent_Formula*)
  case (Formula_Agent_Formula c x y) thus ?case
apply(cases x)
apply(cases free)
apply auto
apply(cases free)
apply auto
done
(*uncommentR?Formula_Agent_Formula*)*)
qed

lemma freevars_replace_Formula_simp2 : "free \<in> freevars (a::Formula) \<longrightarrow> replace (free,free) a = a"
proof (rule, induct a)
(*(*uncommentL?Formula_Atprop*)
  case (Formula_Atprop x)
    have 0: "freevars (Formula_Atprop x) = image (\<lambda>x. Formula_Atprop x) (freevars x)" by simp
    then obtain afree where "afree \<in> freevars x" "Formula_Atprop afree = free"
      by (metis Formula_Atprop.prems freevars_Formula.simps(1) imageE)
    then have "replace (free, free) (Formula_Atprop x) = Formula_Atprop (replace (afree, afree) x)" by auto
    thus ?case
      by (metis freevars_replace_Atprop_simp freevars_replace_Atprop_simp2)
next
(*uncommentR?Formula_Atprop*)*)
(*(*uncommentL?Formula_Freevar*)
  case (Formula_Freevar x)
    show ?case by simp
next
(*uncommentR?Formula_Freevar*)*)
(*(*uncommentL?Formula_Zer*)
  case (Formula_Zer x)
    show ?case by simp
next
(*uncommentR?Formula_Zer*)*)
(*(*uncommentL?Formula_Bin*)
  case (Formula_Bin x c y)
    have 1: "free \<in> freevars (Formula_Bin x c y) \<longrightarrow> replace (free, free) x = x"
    proof rule
      assume "free \<in> freevars (Formula_Bin x c y)"
    { assume "free \<notin> freevars x" then have "replace (free, free) x = x" using freevars_replace_Formula_simp by simp }
      thus "replace (free, free) x = x" by (metis Formula_Bin.hyps(1))
    qed
    have 2: "free \<in> freevars (Formula_Bin x c y) \<longrightarrow> replace (free, free) y = y"
    proof
      assume "free \<in> freevars (Formula_Bin x c y)"
    { assume "free \<notin> freevars y" then have "replace (free, free) y = y" using freevars_replace_Formula_simp by simp }
      thus "replace (free, free) y = y" by (metis Formula_Bin.hyps(2))
    qed
    have "free \<in> freevars (Formula_Bin x c y) \<longrightarrow> replace (free, free) (Formula_Bin x c y) = Formula_Bin (replace (free, free) x) c (replace (free, free) y)" by auto
    with 1 2 show ?case by (metis Formula_Bin.prems)
next
(*uncommentR?Formula_Bin*)*)
(*(*uncommentL?Formula_Un*)
  case (Formula_Un c x)
    thus ?case by simp
next
(*uncommentR?Formula_Un*)*)
(*(*uncommentL?Formula_Action*)
    case (Formula_Action x)
    show ?case by simp
next
(*uncommentR?Formula_Action*)*)
(*(*uncommentL?Formula_Agent*)
  case (Formula_Agent x)
    show ?case by simp
next
(*uncommentR?Formula_Agent*)*)
(*(*uncommentL?Formula_Precondition*)
  case (Formula_Precondition x)
    have 0: "freevars (Formula_Precondition x) = image (\<lambda>x. Formula_Action x) (freevars x)" by simp
    then obtain afree where "afree \<in> freevars x" "Formula_Action afree = free"
      by (metis Formula_Precondition.prems imageE)
    then have "replace (free, free) (Formula_Precondition x) = Formula_Precondition (replace (afree, afree) x)" by auto
    thus ?case by (metis freevars_replace_Action_simp freevars_replace_Action_simp2)
next
(*uncommentR?Formula_Precondition*)*)
(*(*uncommentL?Formula_Action_Formula*)
  case (Formula_Action_Formula c x y)
    have 1: "free \<in> freevars (Formula_Action_Formula c x y) \<longrightarrow> replace (free, free) (Formula_Action x) = (Formula_Action x)" by simp
    have 2: "free \<in> freevars (Formula_Action_Formula c x y) \<longrightarrow> replace (free, free) y = y"
    proof
      assume "free \<in> freevars (Formula_Action_Formula c x y)"
    { assume "free \<notin> freevars y" then have "replace (free, free) y = y" using freevars_replace_Formula_simp by simp }
      thus "replace (free, free) y = y" by (metis Formula_Action_Formula.hyps)
    qed
    with 1 have "free \<in> freevars (Formula_Action_Formula c x y) \<longrightarrow> replace (free, free) (Formula_Action_Formula c x y) = Formula_Action_Formula c x (replace (free, free) y)"
      by (cases free, simp_all) (metis freevars_replace_Action_simp freevars_replace_Action_simp2)
    with 2 show ?case by (metis Formula_Action_Formula.prems)
next
(*uncommentR?Formula_Action_Formula*)*)
(*(*uncommentL?Formula_Agent_Formula*)
  case (Formula_Agent_Formula c x y)
    have 1: "free \<in> freevars (Formula_Agent_Formula c x y) \<longrightarrow> replace (free, free) (Formula_Agent x) = (Formula_Agent x)" by simp
    have 2: "free \<in> freevars (Formula_Agent_Formula c x y) \<longrightarrow> replace (free, free) y = y"
    proof
      assume "free \<in> freevars (Formula_Agent_Formula c x y)"
    { assume "free \<notin> freevars y" then have "replace (free, free) y = y" using freevars_replace_Formula_simp by simp }
      thus "replace (free, free) y = y" by (metis Formula_Agent_Formula.hyps)
    qed
    with 1 have "free \<in> freevars (Formula_Agent_Formula c x y) \<longrightarrow> replace (free, free) (Formula_Agent_Formula c x y) = Formula_Agent_Formula c x (replace (free, free) y)"
      by (cases free, simp_all) (metis freevars_replace_Agent_simp freevars_replace_Agent_simp2)
    with 2 show ?case by (metis Formula_Agent_Formula.prems)
(*uncommentR?Formula_Agent_Formula*)*)
qed

lemma match_Formula_simp : "\<forall>(x, y) \<in> set (match (a::Formula) a). x = y"
proof (induct a)
(*(*uncommentL?Formula_Atprop*)
  case (Formula_Atprop x)
    have 0: "match (Formula_Atprop x) (Formula_Atprop x) = map (\<lambda>(x,y). (Formula_Atprop x, Formula_Atprop y)) (match x x)" by simp
    have "\<forall>a\<in>set (match x x). case a of (x, y) \<Rightarrow> x = y" by (metis match_Atprop_simp)
    then have "\<forall>a\<in>set( map (\<lambda>(x,y). (Formula_Atprop x, Formula_Atprop y)) (match x x)). case a of (x, y) \<Rightarrow> x = y" by auto
    with 0 show ?case using match_Atprop_simp by simp
next
(*uncommentR?Formula_Atprop*)*)
(*(*uncommentL?Formula_Freevar*)
  case (Formula_Freevar x)
    show ?case by auto
next
(*uncommentR?Formula_Freevar*)*)
(*(*uncommentL?Formula_Zer*)
  case (Formula_Zer x)
    show ?case by simp
next
(*uncommentR?Formula_Zer*)*)
(*(*uncommentL?Formula_Bin*)
  case (Formula_Bin x c y)
    have assms: "\<forall>(a, b) \<in> set (match x x). a = b" "\<forall>(a, b) \<in> set (match y y). a = b"
      by (metis Formula_Bin.hyps(1)) (metis Formula_Bin.hyps(2))
    have 0: "set (match (Formula_Bin x c y) (Formula_Bin x c y)) = set ((match x x) @m (match y y))" by simp
    from Formula_Bin have "set ((match x x) @m (match y y)) = set (match x x) \<union> set (match y y)" by simp
    with assms 0 show ?case by auto
next
(*uncommentR?Formula_Bin*)*)
(*(*uncommentL?Formula_Un*)
  case (Formula_Un c x)
    thus ?case by simp
next
(*uncommentR?Formula_Un*)*)
(*(*uncommentL?Formula_Action*)
  case (Formula_Action x)
    show ?case by simp
next
(*uncommentR?Formula_Action*)*)
(*(*uncommentL?Formula_Agent*)
  case (Formula_Agent x)
    show ?case by simp
next
(*uncommentR?Formula_Agent*)*)
(*(*uncommentL?Formula_Precondition*)
  case (Formula_Precondition x)
    have 0: "match (Formula_Precondition x) (Formula_Precondition x) = map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x)" by simp
    have "\<forall>a\<in>set (match x x). case a of (x, y) \<Rightarrow> x = y" by (metis match_Action_simp)
    then have "\<forall>a\<in>set( map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x)). case a of (x, y) \<Rightarrow> x = y" by auto
    with 0 show ?case using match_Atprop_simp by simp
next
(*uncommentR?Formula_Precondition*)*)
(*(*uncommentL?Formula_Action_Formula*)
  case (Formula_Action_Formula c x y)
    have assms: "\<forall>(a, b) \<in> set (match x x). a = b" using match_Action_simp by simp
    then have a: "\<forall>a\<in>set ( map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x) ). case a of (x, y) \<Rightarrow> x = y" by auto
    have 0: "set (match (Formula_Action_Formula c x y) (Formula_Action_Formula c x y)) = set ( map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x) @m (match y y) )" by simp
    with a Formula_Action_Formula have "set ( map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x) @m (match y y)) =
      set ( map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x) ) \<union> set (match y y)" by simp
    with assms 0 show ?case by (metis Formula_Action_Formula.hyps Un_iff a)
next
(*uncommentR?Formula_Action_Formula*)*)
(*(*uncommentL?Formula_Agent_Formula*)
  case (Formula_Agent_Formula c x y)
    have assms: "\<forall>(a, b) \<in> set (match x x). a = b" using match_Agent_simp by simp
    then have a: "\<forall>a\<in>set ( map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match x x) ). case a of (x, y) \<Rightarrow> x = y" by auto
    have 0: "set (match (Formula_Agent_Formula c x y) (Formula_Agent_Formula c x y)) = set ( map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match x x) @m (match y y) )" by simp
    with a Formula_Agent_Formula have "set ( map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match x x) @m (match y y)) =
      set ( map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match x x) ) \<union> set (match y y)" by simp
    with assms 0 show ?case by (metis Formula_Agent_Formula.hyps Un_iff a)
(*uncommentR?Formula_Agent_Formula*)*)
qed

lemma inv_Formula[simp]:
  fixes a::Formula
  shows "\<forall>free \<in> set (match a a). a = replace free a"
proof (induct a)
(*(*uncommentL?Formula_Atprop*)
  case (Formula_Atprop x)
    show ?case
      by (metis (full_types) freevars_replace_Formula_simp freevars_replace_Formula_simp2 match_Formula_simp old.prod.exhaust case_prodD)
next
(*uncommentR?Formula_Atprop*)*)
(*(*uncommentL?Formula_Bin*)
  case (Formula_Bin x c y)
    obtain z where 0: "z = (Formula_Bin x c y)" by simp
    then have 1: "\<forall>free \<in> set (match z z). replace free z = Formula_Bin (replace free x) c (replace free y)" by auto
    have "\<forall>free \<in> set (match z z). replace free x = x" "\<forall>free \<in> set (match z z). replace free y = y"
    proof auto
      fix a b
      assume "(a, b) \<in> set (match z z)"
      then have eq: "a = b" using match_Formula_simp by (metis (full_types) case_prodD)
      have x: "a \<notin> freevars x \<longrightarrow> replace (a,b) x = x" and "a \<in> freevars x \<longrightarrow> replace (a,b) x = x"
        by (metis eq freevars_replace_Formula_simp) (metis freevars_replace_Formula_simp2 eq)
      thus "replace_Formula_aux a b x = x" by auto
      from eq have "a \<notin> freevars y \<longrightarrow> replace (a,b) y = y" "a \<in> freevars y \<longrightarrow> replace (a,b) y = y"
        by (metis eq freevars_replace_Formula_simp) (metis freevars_replace_Formula_simp2 eq)
      thus "replace_Formula_aux a b y = y" by auto
    qed
    thus ?case by (metis "0" "1")
next
(*uncommentR?Formula_Bin*)*)
(*(*uncommentL?Formula_Un*)
  case (Formula_Un c x)
    thus ?case by auto
next
(*uncommentR?Formula_Un*)*)
(*(*uncommentL?Formula_Freevar*)
  case (Formula_Freevar x)
    show ?case by simp
next
(*uncommentR?Formula_Freevar*)*)
(*(*uncommentL?Formula_Zer*)
  case (Formula_Zer x)
    show ?case by simp
next
(*uncommentR?Formula_Zer*)*)
(*(*uncommentL?Formula_Action*)
  case (Formula_Action x)
    show ?case by simp
next
(*uncommentR?Formula_Action*)*)
(*(*uncommentL?Formula_Agent*)
  case (Formula_Agent x)
    show ?case by simp
next
(*uncommentR?Formula_Agent*)*)
(*(*uncommentL?Formula_Precondition*)
  case (Formula_Precondition x)
    show ?case by auto
next
(*uncommentR?Formula_Precondition*)*)
(*(*uncommentL?Formula_Action_Formula*)
  case (Formula_Action_Formula c x y)
    obtain z where 0: "z = (Formula_Action_Formula c x y)" by simp

    have 1: "\<forall>free \<in> set (match z z). replace free (Formula_Action x) = (Formula_Action x)" by auto
    have 2: "\<forall>free \<in> set (match z z). replace free y = y"
    proof auto
      fix a b
      assume "(a, b) \<in> set (match z z)"
      then have eq: "a = b" using match_Formula_simp by (metis (full_types) case_prodD)
      from eq have "a \<notin> freevars y \<longrightarrow> replace (a,b) y = y" "a \<in> freevars y \<longrightarrow> replace (a,b) y = y"
        by (metis eq freevars_replace_Formula_simp) (metis freevars_replace_Formula_simp2 eq)
      thus "replace_Formula_aux a b y = y" by auto
    qed

    have "\<forall>free \<in> set (match z z). replace free (Formula_Action_Formula c x y) = Formula_Action_Formula c x (replace free y)"
    apply auto
    apply (case_tac a)
    apply auto
    apply (case_tac b)
    apply auto
    proof -
      fix a b
      assume assm: "(Formula_Action a, Formula_Action b) \<in> set (match z z)"
      then have eq: "a = b" using match_Formula_simp by (metis (full_types) Formula.inject(1) split_conv)
      thus "replace (a, b) x = x" by (metis eq freevars_replace_Action_simp freevars_replace_Action_simp2)
    qed
    with 0 1 2 show ?case by simp
next
(*uncommentR?Formula_Action_Formula*)*)
(*(*uncommentL?Formula_Agent_Formula*)
  case (Formula_Agent_Formula c x y)
    obtain z where 0: "z = (Formula_Agent_Formula c x y)" by simp

    have 1: "\<forall>free \<in> set (match z z). replace free (Formula_Agent x) = (Formula_Agent x)" by auto
    have 2: "\<forall>free \<in> set (match z z). replace free y = y"
    proof auto
      fix a b
      assume "(a, b) \<in> set (match z z)"
      then have eq: "a = b" using match_Formula_simp by (metis (full_types) case_prodD)
      from eq have "a \<notin> freevars y \<longrightarrow> replace (a,b) y = y" "a \<in> freevars y \<longrightarrow> replace (a,b) y = y"
        by (metis eq freevars_replace_Formula_simp) (metis freevars_replace_Formula_simp2 eq)
      thus "replace_Formula_aux a b y = y" by auto
    qed

    have "\<forall>free \<in> set (match z z). replace free (Formula_Agent_Formula c x y) = Formula_Agent_Formula c x (replace free y)"
    apply auto
    apply (case_tac a)
    apply auto
    apply (case_tac b)
    apply auto
    proof -
      fix a b
      assume assm: "(Formula_Agent a, Formula_Agent b) \<in> set (match z z)"
      then have eq: "a = b" using match_Formula_simp by (metis (full_types) Formula.inject split_conv)
      thus "replace (a, b) x = x" by (metis eq freevars_replace_Agent_simp freevars_replace_Agent_simp2)
    qed
    with 0 1 2 show ?case by simp
(*uncommentR?Formula_Agent_Formula*)*)
qed

lemma inv_Formula2_aux[simp]:
fixes a::Formula and list
assumes "set list \<subseteq> set (match a a)"
shows "replaceAll list a = a"
using assms
by (induct list a rule:replaceAll.induct, simp) (metis insert_subset inv_Formula replaceAll.simps(2) set_simps(2))

lemma inv_Formula2: "replaceAll (match a a) a = (a::Formula)" by simp

(*uncommentR?Formula*)*)

(*(*uncommentL?Structure*)
lemma freevars_replace_Structure_simp : "free \<notin> freevars (a::Structure) \<longrightarrow> replace (free,free) a = a"
proof (induct a)
(*(*uncommentL?Structure_Formula*)
  case (Structure_Formula f) thus ?case using freevars_replace_Formula_simp
    by (cases free, auto)
next
(*uncommentR?Structure_Formula*)*)
(*(*uncommentL?Structure_Zer*)
  case Structure_Zer thus ?case by simp
next
(*uncommentR?Structure_Zer*)*)
(*(*uncommentL?Structure_Bin*)
  case Structure_Bin thus ?case by simp
next
(*uncommentR?Structure_Bin*)*)
(*(*uncommentL?Structure_Freevar*)
  case Structure_Freevar thus ?case by simp
next
(*uncommentR?Structure_Freevar*)*)
(*(*uncommentL?Structure_Phi*)
  case (Structure_Phi act)
    thus ?case
    apply(induct free, auto, case_tac x, simp_all)
    apply(cases act, simp_all)
    done
    (*apply(case_tac x, simp_all, case_tac Action, simp_all)
    by (metis freevars_replace_Action_simp freevars_replace_Action_simp2)*)
next
(*uncommentR?Structure_Phi*)*)
(*(*uncommentL?Structure_Action_Structure*)
  case (Structure_Action_Structure op a s)
    thus ?case
    apply(cases free, cases s, cases a, simp_all, case_tac x5, simp_all, case_tac x1, simp_all)
    by (metis freevars_replace_Action_simp freevars_replace_Action_simp2)
    (*apply(cases free, cases s, cases a, simp_all, case_tac Formula, simp_all, case_tac Action, simp_all)
    by (metis freevars_replace_Action_simp freevars_replace_Action_simp2)*)
next
(*uncommentR?Structure_Action_Structure*)*)
(*(*uncommentL?Structure_Agent_Structure*)
  case (Structure_Agent_Structure op a s)
    thus ?case
    apply(cases free, cases s, cases a, simp_all, case_tac x5, simp_all, case_tac x3, simp_all)
    by (metis freevars_replace_Agent_simp freevars_replace_Agent_simp2)
    (*apply(cases free, cases s, cases a, simp_all, case_tac Formula, simp_all, case_tac Agent, simp_all)
    by (metis freevars_replace_Agent_simp freevars_replace_Agent_simp2)*)
next
(*uncommentR?Structure_Agent_Structure*)*)
(*(*uncommentL?Structure_Bigcomma*)
  (*show "free \<notin> freevars (;;\<^sub>S []) \<longrightarrow> replace (free, free) (;;\<^sub>S []) = ;;\<^sub>S []" by simp
  show "\<And>a list. free \<notin> freevars a \<longrightarrow> replace (free, free) a = a \<Longrightarrow>
              free \<notin> freevars (;;\<^sub>S list) \<longrightarrow> replace (free, free) (;;\<^sub>S list) = ;;\<^sub>S list \<Longrightarrow> free \<notin> freevars (;;\<^sub>S (a # list)) \<longrightarrow> replace (free, free) (;;\<^sub>S (a # list)) = ;;\<^sub>S (a # list)" by simp*)
  case (Structure_Bigcomma list)
    thus ?case
    proof (induct list)
      case(Nil) thus ?case by simp
    next
      case(Cons l ist) thus ?case by simp
    qed
(*uncommentR?Structure_Bigcomma*)*)
qed

lemma freevars_replace_Structure_simp2 : "free \<in> freevars (a::Structure) \<longrightarrow> replace (free,free) a = a"
proof (rule, induct a)
(*(*uncommentL?Structure_Formula*)
  case (Structure_Formula x)
    have 0: "freevars (Structure_Formula x) = image (\<lambda>x. Structure_Formula x) (freevars x)" by simp
    then obtain ffree where "ffree \<in> freevars x"
      by (metis Structure_Formula.prems freevars_Structure.simps(1) imageE)
    with 0 have "replace (free, free) (Structure_Formula x) = Structure_Formula (replace (ffree, ffree) x)"
    proof -
      have "replace (ffree, ffree) x = x" by (metis `ffree \<in> freevars x` freevars_replace_Formula_simp2)
      thus "replace (free, free) (x \<^sub>S) = replace (ffree, ffree) x \<^sub>S" using Structure_Formula.prems freevars_replace_Formula_simp2 by auto
    qed
    thus ?case
      by (metis freevars_replace_Formula_simp freevars_replace_Formula_simp2)
next
(*uncommentR?Structure_Formula*)*)
(*(*uncommentL?Structure_Zer*)
  case (Structure_Zer c)
    thus ?case by simp
next
(*uncommentR?Structure_Zer*)*)
(*(*uncommentL?Structure_Freevar*)
  case (Structure_Freevar x)
    thus ?case by simp
next
(*uncommentR?Structure_Freevar*)*)
(*(*uncommentL?Structure_Bin*)
  case (Structure_Bin x c y)
    have 1: "free \<in> freevars (Structure_Bin x c y) \<longrightarrow> (replace (free, free) x) = x"
    proof rule
      assume "free \<in> freevars (Structure_Bin x c y)"
    { assume "free \<notin> freevars x" then have "replace (free, free) x = x" using freevars_replace_Structure_simp by simp }
      thus "replace (free, free) x = x" by (metis Structure_Bin.hyps(1))
    qed
    have 2: "free \<in> freevars (Structure_Bin x c y) \<longrightarrow> replace (free, free) y = y"
    proof
      assume "free \<in> freevars (Structure_Bin x c y)"
    { assume "free \<notin> freevars y" then have "replace (free, free) y = y" using freevars_replace_Structure_simp by simp }
      thus "replace (free, free) y = y" by (metis Structure_Bin.hyps(2))
    qed
    have "free \<in> freevars (Structure_Bin x c y) \<longrightarrow> replace (free, free) (Structure_Bin x c y) = Structure_Bin (replace (free, free) x) c (replace (free, free) y)" by auto
    thus ?case by (metis "1" "2" Structure_Bin.prems)
next
(*uncommentR?Structure_Bin*)*)
(*(*uncommentL?Structure_Phi*)
  case (Structure_Phi a)
    (*thus ?case by(cases free, simp_all, case_tac Formula, simp_all, case_tac Action, simp_all) (metis freevars_replace_Action_simp freevars_replace_Action_simp2)*)
    thus ?case
    apply(cases free, simp_all, case_tac x5, simp_all, case_tac x1, simp_all )
    by (metis freevars_replace_Action_simp freevars_replace_Action_simp2)
next
(*uncommentR?Structure_Phi*)*)
(*(*uncommentL?Structure_Action_Structure*)
  case (Structure_Action_Structure c x y)
    have 1: "free \<in> freevars (Structure_Action_Structure c x y) \<longrightarrow> replace (free, free) (Structure_Formula (Formula_Action x)) = (Structure_Formula (Formula_Action x))" by(cases free, simp_all)
    have 2: "free \<in> freevars (Structure_Action_Structure c x y) \<longrightarrow> replace (free, free) y = y"
    proof
      assume "free \<in> freevars (Structure_Action_Structure c x y)"
    { assume "free \<notin> freevars y" then have "replace (free, free) y = y" using freevars_replace_Structure_simp by simp }
      thus "replace (free, free) y = y" by (metis Structure_Action_Structure.hyps)
    qed
    with 1 have "free \<in> freevars (Structure_Action_Structure c x y) \<longrightarrow> replace (free, free) (Structure_Action_Structure c x y) = Structure_Action_Structure c x (replace (free, free) y)"
      (*by (cases free, simp_all, case_tac Formula, simp_all, case_tac Action, simp_all) (metis freevars_replace_Action_simp freevars_replace_Action_simp2)*)
      by (cases free, simp_all, case_tac x5, simp_all, case_tac x1, simp_all) (metis freevars_replace_Action_simp freevars_replace_Action_simp2)

    with 2 show ?case by (metis Structure_Action_Structure.prems)
next
(*uncommentR?Structure_Action_Structure*)*)
(*(*uncommentL?Structure_Agent_Structure*)
  case (Structure_Agent_Structure c x y)
    have 1: "free \<in> freevars (Structure_Agent_Structure c x y) \<longrightarrow> replace (free, free) (Structure_Formula (Formula_Agent x)) = (Structure_Formula (Formula_Agent x))" by(cases free, simp_all)
    have 2: "free \<in> freevars (Structure_Agent_Structure c x y) \<longrightarrow> replace (free, free) y = y"
    proof
      assume "free \<in> freevars (Structure_Agent_Structure c x y)"
    { assume "free \<notin> freevars y" then have "replace (free, free) y = y" using freevars_replace_Structure_simp by simp }
      thus "replace (free, free) y = y" by (metis Structure_Agent_Structure.hyps)
    qed
    with 1 have "free \<in> freevars (Structure_Agent_Structure c x y) \<longrightarrow> replace (free, free) (Structure_Agent_Structure c x y) = Structure_Agent_Structure c x (replace (free, free) y)"
      (*by (cases free, simp_all, case_tac Formula, simp_all, case_tac Agent, simp_all) (metis freevars_replace_Agent_simp freevars_replace_Agent_simp2)*)
      by (cases free, simp_all, case_tac x5, simp_all, case_tac x3, simp_all) (metis freevars_replace_Agent_simp freevars_replace_Agent_simp2)

    with 2 show ?case by (metis Structure_Agent_Structure.prems)
next
(*uncommentR?Structure_Agent_Structure*)*)
(*(*uncommentL?Structure_Bigcomma*)
  case (Structure_Bigcomma list)
    thus ?case
    proof (induct list)
      case(Nil) thus ?case by simp
    next
      case(Cons l ist) thus ?case using freevars_replace_Structure_simp replace_Structure.simps by fastforce
    qed
(*  show "replace (free, free) (;;\<^sub>S []) = ;;\<^sub>S []" by simp
  show "\<And>a list. (free \<in> freevars a \<Longrightarrow> replace (free, free) a = a) \<Longrightarrow> replace (free, free) (;;\<^sub>S list) = ;;\<^sub>S list \<Longrightarrow> replace (free, free) (;;\<^sub>S (a # list)) = ;;\<^sub>S (a # list)"
  proof auto
    fix a list
    assume "(free \<in> freevars a \<Longrightarrow> replace_Structure_aux free free a = a)" and assm: "replace_Structure_list_aux free free list = list"
    show "replace_Structure_aux free free a = a" by (metis `free \<in> freevars a \<Longrightarrow> replace_Structure_aux free free a = a` freevars_replace_Structure_simp replace_Structure.simps)
  qed
*)
(*uncommentR?Structure_Bigcomma*)*)
qed

lemma match_Structure_simp : "\<forall>(x, y) \<in> set (match (a::Structure) a). x = y"
proof (induct a)
(*(*uncommentL?Structure_Formula*)
  case (Structure_Formula x)
    have 0: "match (Structure_Formula x) (Structure_Formula x) = map (\<lambda>(x,y). (Structure_Formula x, Structure_Formula y)) (match x x)" by simp
    have "\<forall>a\<in>set (match x x). case a of (x, y) \<Rightarrow> x = y" by (metis match_Formula_simp)
    then have "\<forall>a\<in>set( map (\<lambda>(x,y). (Structure_Formula x, Structure_Formula y)) (match x x)). case a of (x, y) \<Rightarrow> x = y" by auto
    with 0 show ?case using match_Formula_simp by simp
next
(*uncommentR?Structure_Formula*)*)
(*(*uncommentL?Structure_Zer*)
  case (Structure_Zer x)
    show ?case by auto
next
(*uncommentR?Structure_Zer*)*)
(*(*uncommentL?Structure_Freevar*)
  case (Structure_Freevar x)
    show ?case by auto
next
(*uncommentR?Structure_Freevar*)*)
(*(*uncommentL?Structure_Bin*)
  case (Structure_Bin x c y)
    have assms: "\<forall>(a, b) \<in> set (match x x). a = b" "\<forall>(a, b) \<in> set (match y y). a = b"
      by (metis Structure_Bin.hyps(1)) (metis Structure_Bin.hyps(2))
    have 0: "set (match (Structure_Bin x c y) (Structure_Bin x c y)) = set ((match x x) @m (match y y))" by simp
    from Structure_Bin have "set ((match x x) @m (match y y)) = set (match x x) \<union> set (match y y)" by simp
    with assms 0 show ?case by auto
next
(*uncommentR?Structure_Bin*)*)
(*(*uncommentL?Structure_Phi*)
  case (Structure_Phi x)
    have 0: "match (Structure_Phi x) (Structure_Phi x) = map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y))) (match x x)" by simp
    have "\<forall>a\<in>set (match x x). case a of (x, y) \<Rightarrow> x = y" by (metis match_Action_simp)
    then have "\<forall>a\<in>set( map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y))) (match x x) ). case a of (x, y) \<Rightarrow> x = y" by auto
    with 0 show ?case using match_Atprop_simp by simp
next
(*uncommentR?Structure_Phi*)*)
(*(*uncommentL?Structure_Action_Structure*)
  case (Structure_Action_Structure c x y)
    have assms: "\<forall>(a, b) \<in> set (match x x). a = b" using match_Action_simp by simp
    then have a: "\<forall>a\<in>set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y))) (match x x) ). case a of (x, y) \<Rightarrow> x = y" by auto
    have 0: "set (match (Structure_Action_Structure c x y) (Structure_Action_Structure c x y)) = set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y))) (match x x) @m (match y y) )" by simp
    with a Structure_Action_Structure have "set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y))) (match x x) @m (match y y)) =
      set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y))) (match x x) ) \<union> set (match y y)" by simp
    with assms 0 show ?case by (metis Structure_Action_Structure.hyps Un_iff a)
next
(*uncommentR?Structure_Action_Structure*)*)
(*(*uncommentL?Structure_Agent_Structure*)
  case (Structure_Agent_Structure c x y)
    have assms: "\<forall>(a, b) \<in> set (match x x). a = b" using match_Agent_simp by simp
    then have a: "\<forall>a\<in>set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Agent x), Structure_Formula(Formula_Agent y))) (match x x) ). case a of (x, y) \<Rightarrow> x = y" by auto
    have 0: "set (match (Structure_Agent_Structure c x y) (Structure_Agent_Structure c x y)) = set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Agent x), Structure_Formula(Formula_Agent y))) (match x x) @m (match y y) )" by simp
    with a Structure_Agent_Structure have "set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Agent x), Structure_Formula(Formula_Agent y))) (match x x) @m (match y y)) =
      set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Agent x), Structure_Formula(Formula_Agent y))) (match x x) ) \<union> set (match y y)" by simp
    with assms 0 show ?case by (metis Structure_Agent_Structure.hyps Un_iff a)
next
(*uncommentR?Structure_Agent_Structure*)*)
(*(*uncommentL?Structure_Bigcomma*)
  case (Structure_Bigcomma list)
    thus ?case
    proof (induct list)
      case(Nil) thus ?case by simp
    next
      case(Cons l ist) thus ?case by simp
    qed
(*
  show "\<forall>a\<in>set (match (;;\<^sub>S []) (;;\<^sub>S [])). case a of (x, y) \<Rightarrow> x = y" by simp
  show "\<And>a list. \<forall>a\<in>set (match a a). case a of (x, y) \<Rightarrow> x = y \<Longrightarrow>
              \<forall>a\<in>set (match (;;\<^sub>S list) (;;\<^sub>S list)). case a of (x, y) \<Rightarrow> x = y \<Longrightarrow> \<forall>a\<in>set (match (;;\<^sub>S (a # list)) (;;\<^sub>S (a # list))). case a of (x, y) \<Rightarrow> x = y" by simp*)
(*uncommentR?Structure_Bigcomma*)*)
qed

lemma inv_Structure[simp]:
  fixes a::Structure
  shows "\<forall>free \<in> set (match a a). a = replace free a"
proof (induct a)
(*(*uncommentL?Structure_Formula*)
  case (Structure_Formula x)
    thus ?case by auto (metis inv_Formula replace_Formula.simps)
next
(*uncommentR?Structure_Formula*)*)
(*(*uncommentL?Structure_Zer*)
  case (Structure_Zer x)
    show ?case by simp
next
(*uncommentR?Structure_Zer*)*)
(*(*uncommentL?Structure_Bin*)
  case (Structure_Bin x c y)
    obtain z where 0: "z = (Structure_Bin x c y)" by simp
    then have 1: "\<forall>free \<in> set (match z z). replace free z = Structure_Bin (replace free x) c (replace free y)" by auto
    have "\<forall>free \<in> set (match z z). replace free x = x" "\<forall>free \<in> set (match z z). replace free y = y"
    proof auto
      fix a b
      assume "(a, b) \<in> set (match z z)"
      then have eq: "a = b" using match_Structure_simp by (metis (full_types) case_prodD)
      have x: "a \<notin> freevars x \<longrightarrow> replace (a,b) x = x" and "a \<in> freevars x \<longrightarrow> replace (a,b) x = x"
        by (metis eq freevars_replace_Structure_simp) (metis freevars_replace_Structure_simp2 eq)
      thus "replace_Structure_aux a b x = x" by auto
      from eq have "a \<notin> freevars y \<longrightarrow> replace (a,b) y = y" "a \<in> freevars y \<longrightarrow> replace (a,b) y = y"
        by (metis eq freevars_replace_Structure_simp) (metis freevars_replace_Structure_simp2 eq)
      thus "replace_Structure_aux a b y = y" by auto
    qed
    thus ?case by (metis "0" "1")
next
(*uncommentR?Structure_Bin*)*)
(*(*uncommentL?Structure_Freevar*)
  case (Structure_Freevar x)
    show ?case by simp
next
(*uncommentR?Structure_Freevar*)*)
(*(*uncommentL?Structure_Phi*)
  case(Structure_Phi x)
    show ?case by auto
next
(*uncommentR?Structure_Phi*)*)
(*(*uncommentL?Structure_Action_Structure*)
  case (Structure_Action_Structure c x y)
    obtain z where 0: "z = (Structure_Action_Structure c x y)" by simp

    have 1: "\<forall>free \<in> set (match z z). replace free (Structure_Formula(Formula_Action x)) = (Structure_Formula(Formula_Action x))"
    apply (rule)
    apply(case_tac free, auto)
    apply(case_tac aa, auto)
    apply(case_tac ba, auto)
    done

    have 2: "\<forall>free \<in> set (match z z). replace free y = y"
    proof auto
      fix a b
      assume "(a, b) \<in> set (match z z)"
      then have eq: "a = b" using match_Structure_simp by (metis (full_types) case_prodD)
      from eq have "a \<notin> freevars y \<longrightarrow> replace (a,b) y = y" "a \<in> freevars y \<longrightarrow> replace (a,b) y = y"
        by (metis eq freevars_replace_Structure_simp) (metis freevars_replace_Structure_simp2 eq)
      thus "replace_Structure_aux a b y = y" by auto
    qed

    have "\<forall>free \<in> set (match z z). replace free (Structure_Action_Structure c x y) = Structure_Action_Structure c x (replace free y)"
    apply auto
    apply (case_tac a)
    apply auto
    apply (case_tac x5)
    apply auto
    apply (case_tac b)
    apply auto
    apply (case_tac x5)
    apply auto
    proof -
      fix a b
      assume assm: "(Formula_Action a \<^sub>S, Formula_Action b \<^sub>S) \<in> set (match z z)"
      then have eq: "a = b" using match_Structure_simp match_Formula_simp by (metis (poly_guards_query) Formula.inject(1) Structure.inject(5) split_conv)
      thus "replace (a, b) x = x" by (metis eq freevars_replace_Action_simp freevars_replace_Action_simp2)
    qed
    with 0 1 2 show ?case by simp
next
(*uncommentR?Structure_Action_Structure*)*)
(*(*uncommentL?Structure_Agent_Structure*)
    case (Structure_Agent_Structure c x y)
    obtain z where 0: "z = (Structure_Agent_Structure c x y)" by simp

    have 1: "\<forall>free \<in> set (match z z). replace free (Structure_Formula(Formula_Agent x)) = (Structure_Formula(Formula_Agent x))"
    apply (rule)
    apply(case_tac free, auto)
    apply(case_tac aa, auto)
    apply(case_tac ba, auto)
    done

    have 2: "\<forall>free \<in> set (match z z). replace free y = y"
    proof auto
      fix a b
      assume "(a, b) \<in> set (match z z)"
      then have eq: "a = b" using match_Structure_simp by (metis (full_types) case_prodD)
      from eq have "a \<notin> freevars y \<longrightarrow> replace (a,b) y = y" "a \<in> freevars y \<longrightarrow> replace (a,b) y = y"
        by (metis eq freevars_replace_Structure_simp) (metis freevars_replace_Structure_simp2 eq)
      thus "replace_Structure_aux a b y = y" by auto
    qed

    have "\<forall>free \<in> set (match z z). replace free (Structure_Agent_Structure c x y) = Structure_Agent_Structure c x (replace free y)"
    apply auto
    apply (case_tac a)
    apply auto
    apply (case_tac x5)
    apply auto
    apply (case_tac b)
    apply auto
    apply (case_tac x5)
    apply auto
    proof -
      fix a b
      assume assm: "(Formula_Agent a \<^sub>S, Formula_Agent b \<^sub>S) \<in> set (match z z)"
      then have eq: "a = b" using match_Structure_simp match_Formula_simp by (metis (poly_guards_query) Formula.inject Structure.inject split_conv)
      thus "replace (a, b) x = x" by (metis eq freevars_replace_Agent_simp freevars_replace_Agent_simp2)
    qed

    with 0 1 2 show ?case by simp
next
(*uncommentR?Structure_Agent_Structure*)*)
(*(*uncommentL?Structure_Bigcomma*)
  case (Structure_Bigcomma list)
    thus ?case
    proof (induct list)
      case(Nil) thus ?case by simp
    next
      case(Cons l ist) thus ?case by simp
    qed
  (*show "\<forall>free\<in>set (match (Structure_Bigcomma []) (Structure_Bigcomma [])). Structure_Bigcomma [] = replace free (Structure_Bigcomma [])" by simp
  show "\<And>a list. \<forall>free\<in>set (match a a). a = replace free a \<Longrightarrow>
          \<forall>free\<in>set (match (Structure_Bigcomma list) (Structure_Bigcomma list)). Structure_Bigcomma list = replace free (Structure_Bigcomma list) \<Longrightarrow>
          \<forall>free\<in>set (match (Structure_Bigcomma (a # list)) (Structure_Bigcomma (a # list))). Structure_Bigcomma (a # list) = replace free (Structure_Bigcomma (a # list))" by simp*)
(*uncommentR?Structure_Bigcomma*)*)
qed

lemma inv_Structure2_aux[simp]:
fixes a::Structure and list
assumes "set list \<subseteq> set (match a a)"
shows "replaceAll list a = a"
using assms
by (induct list a rule:replaceAll.induct, simp) (metis insert_subset inv_Structure replaceAll.simps(2) set_simps(2))

lemma inv_Structure2: "replaceAll (match a a) a = (a::Structure)" by simp

(*uncommentR?Structure*)*)

(*(*uncommentL?Sequent*)
lemma inv_Sequent[simp]:
  fixes a::Sequent
  shows "\<forall>free \<in> set (match a a). a = replace free a"
proof (induct a)
  case (Sequent_Structure x)
    thus ?case by auto
next
  case (Sequent x y)
    have "\<And>a b. (a, b) \<in> set (match x x @m match y y) \<Longrightarrow> replace_Structure_aux a b x = x"  "\<And>a b. (a, b) \<in> set (match x x @m match y y) \<Longrightarrow> replace_Structure_aux a b y = y"
    proof -
      fix a b
      assume 0: "(a, b) \<in> set (match x x @m match y y)"
      have "\<forall>(a, b) \<in> set (match x x). a = b" "\<forall>(a, b) \<in> set (match y y). a = b" by (metis match_Structure_simp)+
      with 0 have eq: "a = b" by auto
      have "a \<notin> freevars x \<longrightarrow> replace (a, b) x = x" and "a \<in> freevars x \<longrightarrow> replace (a, b) x = x"
        by (metis eq freevars_replace_Structure_simp) (metis freevars_replace_Structure_simp2 eq)
      thus "replace_Structure_aux a b x = x" by auto
      from eq have "a \<notin> freevars y \<longrightarrow> replace (a,b) y = y" "a \<in> freevars y \<longrightarrow> replace (a,b) y = y"
        by (metis eq freevars_replace_Structure_simp) (metis freevars_replace_Structure_simp2 eq)
      thus "replace_Structure_aux a b y = y" by auto
    qed
    thus ?case by auto
qed

lemma inv_Sequent2_aux[simp]:
fixes a::Sequent and list
assumes "set list \<subseteq> set (match a a)"
shows "replaceAll list a = a"
using assms
by (induct list a rule:replaceAll.induct, simp) (metis insert_subset inv_Sequent replaceAll.simps(2) set_simps(2))

lemma inv_Sequent2: "replaceAll (match a a) a = (a::Sequent)" by simp
(*uncommentR?Sequent*)*)

export_code open Sequent in Scala
module_name (*calc_name*) file (*export_path*)
end