(*  Title:      HOL/HOLCF/IOA/meta_theory/TL.thy
    Author:     Olaf Müller
*)

section {* A General Temporal Logic *}

theory TL
imports Pred Sequence
begin

default_sort type

type_synonym
  'a temporal = "'a Seq predicate"

consts
suffix     :: "'a Seq => 'a Seq => bool"
tsuffix    :: "'a Seq => 'a Seq => bool"

validT     :: "'a Seq predicate => bool"

unlift     ::  "'a lift => 'a"

Init         ::"'a predicate => 'a temporal"          ("<_>" [0] 1000)

Box          ::"'a temporal => 'a temporal"   ("[] (_)" [80] 80)
Diamond      ::"'a temporal => 'a temporal"   ("<> (_)" [80] 80)
Next         ::"'a temporal => 'a temporal"
Leadsto      ::"'a temporal => 'a temporal => 'a temporal"  (infixr "~>" 22)

notation (xsymbols)
  Box  ("\<box> (_)" [80] 80) and
  Diamond  ("\<diamond> (_)" [80] 80) and
  Leadsto  (infixr "\<leadsto>" 22)

defs

unlift_def:
  "unlift x == (case x of Def y   => y)"

(* this means that for nil and UU the effect is unpredictable *)
Init_def:
  "Init P s ==  (P (unlift (HD$s)))"

suffix_def:
  "suffix s2 s == ? s1. (Finite s1  & s = s1 @@ s2)"

tsuffix_def:
  "tsuffix s2 s == s2 ~= nil & s2 ~= UU & suffix s2 s"

Box_def:
  "([] P) s == ! s2. tsuffix s2 s --> P s2"

Next_def:
  "(Next P) s == if (TL$s=UU | TL$s=nil) then (P s) else P (TL$s)"

Diamond_def:
  "<> P == .~ ([] (.~ P))"

Leadsto_def:
   "P ~> Q == ([] (P .--> (<> Q)))"

validT_def:
  "validT P == ! s. s~=UU & s~=nil --> (s |= P)"

lemma simple: "[] <> (.~ P) = (.~ <> [] P)"
apply (rule ext)
apply (simp add: Diamond_def NOT_def Box_def)
done

lemma Boxnil: "nil |= [] P"
apply (simp add: satisfies_def Box_def tsuffix_def suffix_def nil_is_Conc)
done

lemma Diamondnil: "~(nil |= <> P)"
apply (simp add: Diamond_def satisfies_def NOT_def)
apply (cut_tac Boxnil)
apply (simp add: satisfies_def)
done

lemma Diamond_def2: "(<> F) s = (? s2. tsuffix s2 s & F s2)"
apply (simp add: Diamond_def NOT_def Box_def)
done

subsection "TLA Axiomatization by Merz"

lemma suffix_refl: "suffix s s"
apply (simp add: suffix_def)
apply (rule_tac x = "nil" in exI)
apply auto
done

lemma reflT: "s~=UU & s~=nil --> (s |= [] F .--> F)"
apply (simp add: satisfies_def IMPLIES_def Box_def)
apply (rule impI)+
apply (erule_tac x = "s" in allE)
apply (simp add: tsuffix_def suffix_refl)
done

lemma suffix_trans: "[| suffix y x ; suffix z y |]  ==> suffix z x"
apply (simp add: suffix_def)
apply auto
apply (rule_tac x = "s1 @@ s1a" in exI)
apply auto
apply (simp (no_asm) add: Conc_assoc)
done

lemma transT: "s |= [] F .--> [] [] F"
apply (simp (no_asm) add: satisfies_def IMPLIES_def Box_def tsuffix_def)
apply auto
apply (drule suffix_trans)
apply assumption
apply (erule_tac x = "s2a" in allE)
apply auto
done

lemma normalT: "s |= [] (F .--> G) .--> [] F .--> [] G"
apply (simp (no_asm) add: satisfies_def IMPLIES_def Box_def)
done

subsection "TLA Rules by Lamport"

lemma STL1a: "validT P ==> validT ([] P)"
apply (simp add: validT_def satisfies_def Box_def tsuffix_def)
done

lemma STL1b: "valid P ==> validT (Init P)"
apply (simp add: valid_def validT_def satisfies_def Init_def)
done

lemma STL1: "valid P ==> validT ([] (Init P))"
apply (rule STL1a)
apply (erule STL1b)
done

(* Note that unlift and HD is not at all used !!! *)
lemma STL4: "valid (P .--> Q)  ==> validT ([] (Init P) .--> [] (Init Q))"
apply (simp add: valid_def validT_def satisfies_def IMPLIES_def Box_def Init_def)
done

subsection "LTL Axioms by Manna/Pnueli"

lemma tsuffix_TL [rule_format (no_asm)]:
"s~=UU & s~=nil --> tsuffix s2 (TL$s) --> tsuffix s2 s"
apply (unfold tsuffix_def suffix_def)
apply auto
apply (tactic {* Seq_case_simp_tac @{context} "s" 1 *})
apply (rule_tac x = "a>>s1" in exI)
apply auto
done

lemmas tsuffix_TL2 = conjI [THEN tsuffix_TL]

declare split_if [split del]
lemma LTL1:
   "s~=UU & s~=nil --> (s |= [] F .--> (F .& (Next ([] F))))"
apply (unfold Next_def satisfies_def NOT_def IMPLIES_def AND_def Box_def)
apply auto
(* []F .--> F *)
apply (erule_tac x = "s" in allE)
apply (simp add: tsuffix_def suffix_refl)
(* []F .--> Next [] F *)
apply (simp split add: split_if)
apply auto
apply (drule tsuffix_TL2)
apply assumption+
apply auto
done
declare split_if [split]

lemma LTL2a:
    "s |= .~ (Next F) .--> (Next (.~ F))"
apply (unfold Next_def satisfies_def NOT_def IMPLIES_def)
apply simp
done

lemma LTL2b:
    "s |= (Next (.~ F)) .--> (.~ (Next F))"
apply (unfold Next_def satisfies_def NOT_def IMPLIES_def)
apply simp
done

lemma LTL3:
"ex |= (Next (F .--> G)) .--> (Next F) .--> (Next G)"
apply (unfold Next_def satisfies_def NOT_def IMPLIES_def)
apply simp
done

lemma ModusPonens: "[| validT (P .--> Q); validT P |] ==> validT Q"
apply (simp add: validT_def satisfies_def IMPLIES_def)
done

end


(*  Title:      HOL/Corec_Examples/Stream_Processor.thy
    Author:     Andreas Lochbihler, ETH Zuerich
    Author:     Dmitriy Traytel, ETH Zuerich
    Author:     Andrei Popescu, TU Muenchen
    Copyright   2014, 2016

Stream processors---a syntactic representation of continuous functions on streams.
*)

section \<open>Stream Processors---A Syntactic Representation of Continuous Functions on Streams\<close>

theory Stream_Processor
imports "HOL-Library.BNF_Corec" "HOL-Library.Stream"
begin

datatype (discs_sels) ('a, 'b, 'c) sp\<^sub>\<mu> =
  Get "'a \<Rightarrow> ('a, 'b, 'c) sp\<^sub>\<mu>"
| Put "'b" "'c"

codatatype ('a, 'b) sp\<^sub>\<nu> =
  In (out: "('a, 'b, ('a, 'b) sp\<^sub>\<nu>) sp\<^sub>\<mu>")

definition "sub \<equiv> {(f a, Get f) | a f. True}"

lemma subI[intro]: "(f a, Get f) \<in> sub"
  unfolding sub_def by blast

lemma wf_sub[simp, intro]: "wf sub"
proof (rule wfUNIVI)
  fix P  :: "('a, 'b, 'c) sp\<^sub>\<mu> \<Rightarrow> bool" and x
  assume "\<forall>x. (\<forall>y. (y, x) \<in> sub \<longrightarrow> P y) \<longrightarrow> P x"
  hence I: "\<And>x. (\<forall>y. (\<exists>a f. y = f a \<and> x = Get f) \<longrightarrow> P y) \<Longrightarrow> P x" unfolding sub_def by blast
  show "P x" by (induct x) (auto intro: I)
qed

definition get where
  "get f = In (Get (\<lambda>a. out (f a)))"

corecursive run :: "('a, 'b) sp\<^sub>\<nu> \<Rightarrow> 'a stream \<Rightarrow> 'b stream" where
  "run sp s = (case out sp of
     Get f \<Rightarrow> run (In (f (shd s))) (stl s)
   | Put b sp \<Rightarrow> b ## run sp s)"
  by (relation "map_prod In In ` sub <*lex*> {}")
    (auto simp: inj_on_def out_def split: sp\<^sub>\<nu>.splits intro: wf_map_prod_image)

corec copy where
  "copy = In (Get (\<lambda>a. Put a copy))"

friend_of_corec get where
  "get f = In (Get (\<lambda>a. out (f a)))"
  by (auto simp: rel_fun_def get_def sp\<^sub>\<mu>.rel_map rel_prod.simps, metis sndI)

lemma run_simps [simp]:
  "run (In (Get f)) s = run (In (f (shd s))) (stl s)"
  "run (In (Put b sp)) s = b ## run sp s"
by(subst run.code; simp; fail)+

lemma copy_sel[simp]: "out copy = Get (\<lambda>a. Put a copy)"
  by (subst copy.code; simp)

corecursive sp_comp (infixl "oo" 65) where
  "sp oo sp' = (case (out sp, out sp') of
      (Put b sp, _) \<Rightarrow> In (Put b (sp oo sp'))
    | (Get f, Put b sp) \<Rightarrow> In (f b) oo sp
    | (_, Get g) \<Rightarrow> get (\<lambda>a. (sp oo In (g a))))"
  by (relation "map_prod In In ` sub <*lex*> map_prod In In ` sub")
    (auto simp: inj_on_def out_def split: sp\<^sub>\<nu>.splits intro: wf_map_prod_image)

lemma run_copy_unique:
    "(\<And>s. h s = shd s ## h (stl s)) \<Longrightarrow> h = run copy"
apply corec_unique
apply(rule ext)
apply(subst copy.code)
apply simp
done

end


subsection\<open>SC to ND\<close>
theory SCND
imports SC ND
begin

lemma SCND: "\<Gamma> \<Rightarrow> \<Delta> \<Longrightarrow> (set_mset \<Gamma>) \<union> Not ` (set_mset \<Delta>) \<turnstile> \<bottom>"
proof(induction \<Gamma> \<Delta> rule: SCp.induct)
  case BotL thus ?case by (simp add: ND.Ax)
next
  case Ax thus ?case by (meson ND.Ax NotE UnCI image_iff)
next
  case NotL thus ?case by (simp add: NotI)
next
  case (NotR F \<Gamma> \<Delta>) thus ?case by (simp add: Not2IE)
next
  case (AndL F G \<Gamma> \<Delta>) thus ?case by (simp add: AndL_sim)
next
  case (AndR \<Gamma> F \<Delta> G) thus ?case by(simp add: AndR_sim)
next
  case OrL thus ?case by (simp add: OrL_sim)
next
  case OrR thus ?case using OrR_sim[where 'a='a] by (simp add: insert_commute)
next
  case (ImpL \<Gamma> F \<Delta> G) from ImpL.IH show ?case by (simp add: ImpL_sim)
next
  case ImpR from ImpR.IH show ?case by (simp add: ImpR_sim)
qed

end


(*
 * Copyright 2016, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the GNU General Public License version 2. Note that NO WARRANTY is provided.
 * See "LICENSE_GPLv2.txt" for details.
 *
 * @TAG(NICTA_GPL)
 *)

theory FunBucket
imports
  TypBucket
  L4vBucket
begin

definition count :: "'a list \<Rightarrow> ('b::len) word"
 where
"count xs \<equiv> of_nat (length xs) :: 'b word"

definition is_pow_of_2 :: "U32 \<Rightarrow> bool"
where
 "is_pow_of_2 x \<equiv> \<exists>k. x = 1 << k \<and> k < 32"

declare fun_app_def [iff]

text {* slice: Return a slice of a list, frm and to are offset from the
beginning of the list *}
definition
  slice :: "nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> 'a list"
where
 "slice frm to xs  \<equiv> drop frm $ take to xs"

lemma length_slice:
 "length (slice f t xs) = min (length xs) t - f"
 by (simp add: slice_def)

lemma slice_n_n:
 "slice n n xs = []"
 by (simp add: slice_def)

lemma slice_append: "slice f t (xs @ ys) = slice f t xs @ slice (f - min (length xs) t) (t - length xs) ys"
 by  (simp add: slice_def)

lemmas slice_simps = length_slice slice_n_n slice_append slice_def

lemma sub_mod_mask:
  "\<lbrakk>k < 32 \<rbrakk> \<Longrightarrow> (x::32 word) - x mod 2^k = x && ~~ mask k"
  apply (simp add: word_mod_2p_is_mask p2_gt_0 mask_out_sub_mask)
  done

lemma alignUp_not_aligned_eq2:
  " \<not> is_aligned a n \<Longrightarrow> WordSetup.alignUp a n = ((a >> n) + 1) << n"
  apply (cases "n < size a")
   apply (subst alignUp_not_aligned_eq, assumption)
    apply (simp add: word_size)
   apply (simp add: shiftr_div_2n_w shiftl_t2n)
  apply (simp add: WordSetup.alignUp_def power_overflow
        word_size complement_def shiftl_zero_size)
 done

lemma alignUp_not_aligned_eq3:
  "\<not> is_aligned a n \<Longrightarrow> WordSetup.alignUp a n = (a && ~~ mask n) + (1 << n)"
  by (simp add: alignUp_not_aligned_eq2 word_shiftl_add_distrib and_not_mask)

lemma alignUp_def2:
  "alignUp a sz = a + 2 ^ sz - 1 && ~~ mask sz"
   unfolding alignUp_def[unfolded complement_def]
   apply (subst word_log_esimps)
   apply (simp add:mask_def[symmetric,unfolded shiftl_t2n,simplified])
   done

lemma align32_alignUp:
  "\<lbrakk>y = 1 << k; k < 32\<rbrakk> \<Longrightarrow> align32(x,y) = alignUp x k"
  apply (clarsimp simp: align32_def)
  apply (fold mask_def[simplified])
  apply (subst mask_def, simp)
  apply (subst add_diff_eq)
  apply (subst alignUp_def2[symmetric])
  by simp

lemma align32_eq:
  "\<lbrakk>y=1<<k; k < 32\<rbrakk> \<Longrightarrow> align32(x,y) = (if y udvd x then x else x + y - (x mod y))"
  apply (simp add: align32_alignUp)
  apply safe
   apply (simp add: udvd_iff_dvd)
   apply (simp add: and_mask_dvd_nat)
   apply (simp only: is_aligned_mask[symmetric])
   apply (simp add: alignUp_idem)
  apply (subst diff_add_eq[symmetric])
  apply (subst sub_mod_mask, assumption)
  apply (subst alignUp_not_aligned_eq3)
   apply (clarsimp simp: is_aligned_def udvd_iff_dvd)
  apply clarsimp
  done

lemma align32_unchanged:
  "\<lbrakk>is_pow_of_2 a; a udvd x\<rbrakk> \<Longrightarrow> align32 (x,a) = x"
  by (clarsimp simp: is_pow_of_2_def align32_eq)

lemma alignUp_not_aligned_eq': "\<not> is_aligned x k
    \<Longrightarrow> alignUp x k = x + (2 ^ k - (x && mask k))"
  apply (subst alignUp_not_aligned_eq3, assumption)
  apply (subst mask_out_sub_mask)
  apply simp
  done

lemma al_dvd_align32:
  "\<lbrakk>is_pow_of_2 al; v < v + al\<rbrakk> \<Longrightarrow> al udvd align32 (v, al)"
  by (clarsimp simp: is_pow_of_2_def align32_alignUp
                        udvd_iff_dvd is_aligned_def[symmetric])

lemma align32_le:
  "\<lbrakk>is_pow_of_2 al; v < v + al\<rbrakk> \<Longrightarrow> v \<le> align32 (v, al)"
  apply (case_tac "v=0", clarsimp simp: align32_alignUp)
  apply (clarsimp simp: align32_alignUp is_pow_of_2_def)
  apply (case_tac "is_aligned v k")
   apply (rule alignUp_ge, simp)
   apply (rule_tac x=v in alignUp_is_aligned_nz)
      apply simp
     apply simp
    apply simp
   apply simp
  apply (simp add: alignUp_not_aligned_eq')
  apply (drule word_less_sub_1)
  apply (rule word_plus_mono_right2)
   apply (subst(asm) field_simps[symmetric], assumption)
  apply (rule word_le_minus_mono_right)
    apply (clarsimp simp: lt1_neq0 is_aligned_mask)
   apply (rule order_trans, rule word_and_le1)
   apply (rule order_less_imp_le)
   apply (simp add: mask_lt_2pn)
  apply (simp add: word_1_le_power)
  done

lemma align32_ge:
  "\<lbrakk>is_pow_of_2 al; v < v + al\<rbrakk> \<Longrightarrow> align32 (v, al) \<ge> v"
   by (auto simp:align32_le)

lemma alignUp_greater:
  "\<lbrakk>(v::32 word) < 2^n; v \<noteq> 0\<rbrakk> \<Longrightarrow> alignUp v n = 2^n"
  apply (subst alignUp_not_aligned_eq')
   apply (clarsimp simp: aligned_small_is_0)
  apply (simp add: less_mask_eq)
  done

lemma mask_out_add_aligned:
  assumes al: "is_aligned p n"
  shows "p + (q && ~~ mask n) = (p + q) && ~~ mask n"
  using mask_add_aligned [OF al]
  by (simp add: mask_out_sub_mask)

lemma is_aligned_triv2:
  "is_aligned (2^a) a"
   apply (case_tac "word_bits\<le> a")
   apply (simp add:is_aligned_triv)+
   done

lemma alignUp_def3:
  "alignUp a sz = 2^ sz + (a - 1 && ~~ mask sz)" (is "?lhs = ?rhs")
   apply (simp add:alignUp_def2)
   apply (subgoal_tac "2 ^ sz + a - 1 && ~~ mask sz = ?rhs")
    apply (clarsimp simp:field_simps)
   apply (subst mask_out_add_aligned)
   apply (rule is_aligned_triv2)
   apply (simp add:field_simps)
   done

lemma mask_lower_twice:
  "n \<le> m \<Longrightarrow> (x && ~~ mask n) && ~~ mask m = x && ~~ mask m"
  apply (rule word_eqI)
  apply (simp add: word_size word_ops_nth_size)
  apply safe
  apply simp
  done

lemma alignUp_distance:
  "(alignUp (q :: 'a :: len word) sz) - q \<le> mask sz"
  apply (case_tac "len_of TYPE('a) \<le> sz")
   apply (simp add:alignUp_def2 mask_def power_overflow)
  apply (case_tac "is_aligned q sz")
  apply (clarsimp simp:alignUp_def2 p_assoc_help)
   apply (subst mask_out_add_aligned[symmetric],simp)+
   apply (simp add:mask_lower_twice word_and_le2)
   apply (simp add:and_not_mask)
   apply (subst le_mask_iff[THEN iffD1])
    apply (simp add:mask_def)
   apply simp
  apply (clarsimp simp:alignUp_def3)
  apply (subgoal_tac "2 ^ sz - (q - (q - 1 && ~~ mask sz)) \<le> 2 ^ sz - 1")
   apply (simp add:field_simps mask_def)
  apply (rule word_sub_mono)
   apply simp
   apply (rule ccontr)
   apply (clarsimp simp:not_le)
   apply (drule eq_refl)
   apply (drule order_trans[OF _ word_and_le2])
   apply (subgoal_tac "q \<noteq>  0")
    apply (drule minus_one_helper[rotated])
     apply simp
    apply simp
   apply (fastforce)
  apply (simp add: word_sub_le_iff)
  apply (subgoal_tac "q - 1 && ~~ mask sz = (q - 1) - (q - 1 && mask sz)")
   apply simp
   apply (rule order_trans)
    apply (rule word_add_le_mono2)
     apply (rule word_and_le1)
    apply (subst unat_plus_simple[THEN iffD1,symmetric])
     apply (simp add:not_le mask_def)
     apply (rule word_sub_1_le)
     apply simp
    apply (rule unat_lt2p)
   apply (simp add:mask_def)
  apply (simp add:mask_out_sub_mask)
  apply (rule word_sub_1_le)
  apply simp
  done

lemma alignUp_nz:
  "\<lbrakk>(v :: 32 word) \<noteq> 0; v < v + 2^k; k < 32\<rbrakk> \<Longrightarrow> alignUp v k \<noteq> 0"
  apply (cut_tac v=v and al="2^k" in align32_le, simp add: is_pow_of_2_def)
    apply (rule_tac x=k in exI, simp+)
  apply (subst (asm) align32_alignUp[simplified], simp+)
  apply auto
  done

lemma aligned_neq_into_ineq:
  fixes x :: "'a::len word"
  assumes neq: "x \<noteq> y"
  and alx: "is_aligned x sz"
  and aly: "is_aligned y sz"
  shows "x + 2 ^ sz - 1 < y \<or> y + 2 ^ sz - 1 < x"
proof -
  note no_ov = aligned_neq_into_no_overlap [OF neq alx aly]
  note x = eqset_imp_iff[OF no_ov, where x=x]
  note y = eqset_imp_iff[OF no_ov, where x=y]
  from x y show ?thesis
   apply (simp add: is_aligned_no_overflow' alx aly)
   apply (auto simp: field_simps)
   done
qed

lemma align32_upper_bound:
 "\<lbrakk>v \<le> bound; is_pow_of_2 al; al udvd bound; v < v + al\<rbrakk> \<Longrightarrow>
  align32 (v, al) \<le> bound"
  apply (case_tac "v=0")
   apply (clarsimp simp: align32_alignUp is_pow_of_2_def alignUp_def2 mask_def)
  apply (clarsimp simp: is_pow_of_2_def)
  apply (subst (asm) udvd_iff_dvd)
  apply simp
  apply (fold is_aligned_def)
  apply (subst align32_alignUp, simp+)
  apply (case_tac "is_aligned v k")
   apply (simp add: alignUp_idem)
  apply (case_tac "al > v")
   apply (subst alignUp_greater, simp+)
   apply (drule_tac a=bound in is_aligned_less_sz)
    apply clarsimp
   apply (simp add: le_def[symmetric])
  apply (simp add: le_def[symmetric])
  apply (cut_tac p=v and n=k in is_aligned_alignUp)
  apply (cut_tac q=v and sz=k in alignUp_distance)
  apply (drule word_diff_ls'(3))
   apply (drule word_less_sub_1)
   apply (simp add: mask_def word_less_sub_1)
   apply (subst diff_add_eq)
   apply (simp add: add.commute)
  apply (case_tac "v + 2^k \<le> bound")
   apply (simp add: mask_def)
   apply (cut_tac v=v and k=k in alignUp_nz, simp+)
   apply (metis (erased, hide_lams) add.commute add_diff_eq
                not_less order_trans word_le_less_eq word_less_1 word_sub_le)
  apply (subst (asm) word_not_le)
  apply (case_tac "bound = alignUp v k")
   apply simp
  apply (frule_tac x=bound and y="alignUp v k" and sz=k
                      in aligned_neq_into_ineq, assumption+)
  apply (simp add: mask_def)
  apply safe
   apply (metis alignUp_le_greater_al word_bits_conv word_bits_def)
  by (metis alignUp_le_greater_al word_bits_conv word_bits_def)

lemma align32_idempotence:
 "is_pow_of_2 y \<Longrightarrow> x < x + y \<Longrightarrow>
 align32 (align32 (x, y), y) = align32 (x, y)"
 apply (frule (1) al_dvd_align32)
 apply (erule (1) align32_unchanged)
done

end


theory UniversalProperty
  imports "Generators" "FreeGroupMain" "CancelResults" "Iter_Reduction_Results"
begin

definition (in group) genmap
  where "genmap S f g = (if g \<in> S then f g else inv (f (wordinverse g)))"

definition freeg :: "_  \<Rightarrow> bool"
  where "freeg G  = ((group G) \<and> (\<exists>X \<subseteq> carrier G . \<forall>group H .(\<forall>f \<in> X \<rightarrow> carrier H . (\<exists>g \<in> hom G H . (\<forall>x \<in> X . f x = g x) \<and> (\<forall>h \<in> hom G H. \<forall>x \<in> X .f x = h x \<longrightarrow> (\<forall>y \<in> carrier G.  g y = h y))))))"

definition inclusion ("\<iota>")
  where "\<iota> g = [(g, True)]"

definition unlift :: "(('a, 'b) word set\<Rightarrow> 'c) \<Rightarrow> ('a, 'b) monoidgentype set\<Rightarrow> (('a, 'b) word set) set \<Rightarrow> ('a, 'b) word \<Rightarrow> 'c"
  where "unlift f gens S x = f (reln_tuple \<langle>gens\<rangle> `` {x})"

lemma (in group) genmap_closed:
  assumes cl: "f \<in> (\<iota> ` (gens ::('c, 'd) monoidgentype set)) \<rightarrow> carrier G"
      and "g \<in> (\<iota> ` gens) \<union> (wordinverse ` (\<iota> ` gens))"
    shows "genmap (\<iota> ` gens) f g \<in> carrier G"
proof-
  have 1:"g \<in> (\<iota> ` gens) \<or> g \<in> (wordinverse ` (\<iota> ` gens))" using assms(2) by blast
  then show ?thesis
  proof(cases "g \<in> (\<iota> ` gens)")
    case True
    then show ?thesis using assms by (metis Pi_mem genmap_def)
  next
    case False
    then have 2: "g \<in> (wordinverse ` (\<iota> ` gens))" using 1 by simp
    then have "genmap (\<iota> ` gens) f g =  inv (f (wordinverse g))" by (simp add: False genmap_def)
    moreover have "wordinverse g  \<in> (\<iota> ` gens)" by (metis 1 False image_iff wordinverse_symm)
    ultimately show ?thesis using assms by (metis Pi_mem Units_eq Units_inv_Units)
  qed
qed

fun (in group) genmapext
  where "genmapext S f [] = \<one>"|
"genmapext S f (x#xs) = (genmap S f [x]) \<otimes> (genmapext S f xs)"

lemma gen_spanset: assumes "xs \<in> \<langle>S\<rangle>" "xs \<noteq> []" shows "hd xs \<in> invgen S"
  by (metis assms(1) assms(2) freewords_on_def list.sel(1) words_on.cases)

lemma inclusion_union:
  assumes "a \<in> (gens ::('a, 'b) monoidgentype set) \<times> {True, False}"
  shows "[a] \<in> (\<iota> ` gens) \<union> (wordinverse ` (\<iota> ` gens))"
proof(cases "snd a = True")
  case True
  have "fst a \<in> gens" using assms by auto
  then show ?thesis by (metis (mono_tags, lifting) True UnI1 inclusion_def rev_image_eqI surjective_pairing)
next
  case False
  have 1:"fst a \<in> gens" using assms by auto
  moreover have "snd a = False" using assms False by simp
  ultimately have "inverse a = (fst a, True)" by (metis inverse.simps(2) prod.collapse)
  then have "wordinverse [a] \<in> (\<iota> ` gens)" by (simp add: 1 inclusion_def)
  then show ?thesis  by (metis UnCI imageI wordinverse_of_wordinverse)
qed

lemma (in group) genmapext_closed:
  assumes "f \<in> (\<iota> ` (gens ::('c, 'd) monoidgentype set)) \<rightarrow> carrier G"
      and "x \<in> freewords_on  gens"
    shows "genmapext (\<iota> ` gens) f x \<in> carrier G"
  using assms
proof(induction x)
  case Nil
  then show ?case by simp
next
  case (Cons a x)
  have a:"genmapext (\<iota> ` gens) f (a # x) = genmap (\<iota> ` gens) f [a] \<otimes>  (genmapext (\<iota> ` gens)  f x)" by simp
  have "a \<in> gens \<times> {True, False}"  using freewords_on_def gen_spanset invgen_def Cons by (metis list.distinct(1) list.sel(1))
  then have "[a] \<in> (\<iota> ` gens) \<union> (wordinverse ` (\<iota> ` gens))" using inclusion_union  by blast
  then have " genmap (\<iota> ` gens) f [a] \<in> carrier G" using genmap_closed Cons.prems(1) by metis
  moreover have "x \<in> \<langle>gens\<rangle>" using Cons.prems(2) freewords_on_def span_cons by blast
  ultimately show ?case using a by (simp add: Cons.IH assms(1))
qed

lemma (in group) genmapext_append:
  assumes "f \<in> (\<iota> ` (gens ::('c, 'd) monoidgentype set)) \<rightarrow> carrier G"
      and "x \<in> freewords_on gens"
      and "y \<in> freewords_on gens"
    shows "genmapext (\<iota> ` gens)  f (x @ y) = genmapext (\<iota> ` gens) f x \<otimes> genmapext (\<iota> ` gens) f y"
  using assms
proof(induction x)
  case Nil
  have "genmapext (\<iota> ` gens) f [] = \<one>" by simp
  moreover have "genmapext (\<iota> ` gens) f y \<in> carrier G" using genmapext_closed assms by auto
  then have "genmapext (\<iota> ` gens) f [] \<otimes> genmapext (\<iota> ` gens)  f y = genmapext (\<iota> ` gens) f y" using r_one by simp
  then show ?case by simp
next
  case (Cons a x)
  have "a \<in> gens \<times> {True, False}" using freewords_on_def gen_spanset invgen_def Cons by (metis list.distinct(1) list.sel(1))
  then have a:"[a] \<in> (\<iota> ` gens) \<union> (wordinverse ` (\<iota> ` gens))" using inclusion_union  by blast
  have x:"x \<in> \<langle>gens\<rangle>" using Cons.prems(2) freewords_on_def span_cons by blast
  have "genmapext (\<iota> ` gens) f (a # x) \<otimes> genmapext (\<iota> ` gens) f y = genmap (\<iota> ` gens) f [a] \<otimes> genmapext (\<iota> ` gens) f x \<otimes> genmapext (\<iota> ` gens) f y" by simp
  then have 1: "genmapext (\<iota> ` gens) f (a # x) \<otimes> genmapext (\<iota> ` gens) f y = genmap (\<iota> ` gens) f [a] \<otimes> genmapext (\<iota> ` gens) f (x @ y)"
    using Cons.IH Cons.prems(1) Cons.prems(3)  a genmap_closed genmapext_closed m_assoc x by metis
  have "genmapext  (\<iota> ` gens) f ((a # x) @ y) = genmapext (\<iota> ` gens) f (a # (x  @ y))" by auto
  then have "genmapext (\<iota> ` gens) f ((a #x) @ y) = genmap (\<iota> ` gens) f [a] \<otimes> genmapext (\<iota> ` gens) f (x @ y)" by simp
  then show ?case using 1 by auto
qed

lemma cancels_to_1_unfold:
  assumes "cancels_to_1 x y"
  obtains xs1 x1 x2 xs2
  where "x = xs1 @ x1 # x2 # xs2"
    and "y = xs1 @ xs2"
    and "inverse x1 = x2"
proof-
  assume a: "(\<And>xs1 x1 x2 xs2. \<lbrakk>x = xs1 @ x1 # x2 # xs2; y = xs1 @ xs2; inverse x1 =  x2\<rbrakk> \<Longrightarrow> thesis)"
  from assms
  obtain i where "cancels_to_1_at i x y"
    unfolding cancels_to_1_def by auto
  hence "inverse (x ! i) =  (x ! Suc i)"
    and "y = (take i x) @ (drop (Suc (Suc i)) x)"
    and "x = (take i x) @ x ! i # x ! Suc i # (drop (Suc (Suc i)) x)"
    unfolding cancel_at_def and cancels_to_1_at_def by (auto simp add: Cons_nth_drop_Suc)
  with a show thesis by blast
qed

lemma cancels_to_1_preserves:
  assumes "cancels_to_1 x y"
      and "x \<in> freewords_on gens"
    shows "y \<in> freewords_on gens"
proof-
  obtain xs1 x1 x2 xs2
  where x:"x = xs1 @ x1 # x2 # xs2"
    and y:"y = xs1 @ xs2"
    using assms cancels_to_1_unfold by metis
  have "xs1 \<in> freewords_on gens" using x leftappend_span freewords_on_def assms(2) by blast
  moreover have "xs2 \<in> freewords_on gens" using x rightappend_span freewords_on_def assms(2) span_cons by blast
  ultimately show ?thesis using y by (simp add: span_append freewords_on_def)
qed

lemma cancels_to_preserves:
  assumes "cancels_to x y"
      and "x \<in> freewords_on gens"
    shows "y \<in> freewords_on gens"
  using assms unfolding cancels_to_def
proof(induct rule:rtranclp.induct)
  case (rtrancl_refl a)
  then show ?case by simp
next
  case (rtrancl_into_rtrancl a b c)
  then show ?case using cancels_to_1_preserves by auto
qed

lemma inclusion_snd:
  assumes "[x] \<in> (\<iota> ` gens)"
  shows "snd x = True"
proof-
  show ?thesis using assms  by (metis image_iff inclusion_def last.simps old.prod.inject prod.collapse)
qed

lemma (in group) inverse_ext:
  assumes  "inverse x1 = x2"
  and "[x1] \<in> freewords_on (gens ::('c, 'd) monoidgentype set)"
  and "[x2] \<in> freewords_on gens"
  and "f \<in> (\<iota> ` gens) \<rightarrow> carrier G"
  shows "(genmapext (\<iota> ` gens) f [x1] \<otimes> genmapext (\<iota> ` gens) f [x2]) = \<one>"
proof-
  have "genmapext (\<iota> ` gens) f [x1] = genmap (\<iota> ` gens) f [x1] \<otimes> \<one>" by simp
  have x1:"x1 \<in> gens \<times> {True, False}" using  invgen_def gen_spanset freewords_on_def assms(2)  by (metis list.distinct(1) list.sel(1))
  then have "[x1] \<in> (\<iota> ` gens) \<union> (wordinverse ` (\<iota> ` gens))" using inclusion_union  by blast
  then have g1:"genmap (\<iota> ` gens) f [x1] \<in> carrier G" using genmap_closed[of "f" "gens" "[x1]"] assms(4) by fast
  moreover have "genmapext (\<iota> ` gens) f [x1] = genmap (\<iota> ` gens) f [x1] \<otimes> \<one>" by simp
  ultimately have 1:"genmapext (\<iota> ` gens) f [x1] = genmap (\<iota> ` gens) f [x1]" by simp
  have "genmapext (\<iota> ` gens) f [x2] = genmap (\<iota> ` gens) f [x2] \<otimes> \<one>" by simp
  have x2:"x2 \<in> gens \<times> {True, False}" using  invgen_def gen_spanset freewords_on_def assms(3)  by (metis list.distinct(1) list.sel(1))
  then have "[x2] \<in> (\<iota> ` gens) \<union> (wordinverse ` (\<iota> ` gens))" using inclusion_union  by blast
  then have g2:"genmap (\<iota> ` gens) f [x2] \<in> carrier G" using genmap_closed assms(4) by blast
  moreover have "genmapext (\<iota> ` gens) f [x2] = genmap (\<iota> ` gens) f [x2] \<otimes> \<one>" by simp
  ultimately have 2:"genmapext (\<iota> ` gens) f [x2] = genmap (\<iota> ` gens) f [x2]" by simp
  have fx1:"fst x1 \<in> gens" using x1 by auto
  have fx2:"fst x2 \<in> gens" using x2 by auto
  then show ?thesis
  proof (cases "snd x1 = False")
    case True
    then have "snd x2 = True" using assms(1) by (metis inverse.simps(2) snd_eqD surjective_pairing)
    then have "[x2] \<in> (\<iota> ` gens)" using fx2 by (metis inclusion_def rev_image_eqI surjective_pairing)
    then have a:"genmap (\<iota> ` gens) f [x2] = f [x2]" by (simp add: genmap_def)
    have "[x1] \<notin> (\<iota> ` gens)" using inclusion_snd True  by metis
    moreover have "wordinverse [x1] = [x2]" by (simp add: assms(1))
    ultimately have "genmap (\<iota> ` gens) f [x1] = inv (f [x2])" by (simp add: genmap_def)
    then show ?thesis  using 1 2 a  Units_eq Units_l_inv g2 by presburger
next
  case False
    then have T:"snd x1 = True" using assms(1) by (metis inverse.simps(2) snd_eqD surjective_pairing)
    then have "[x1] \<in> (\<iota> ` gens)" using fx1 by (metis inclusion_def rev_image_eqI surjective_pairing)
    then have a:"genmap (\<iota> ` gens) f [x1] = f [x1]" by (simp add: genmap_def)
    have "snd x2 = False" using T assms(1) by (metis eq_snd_iff inverse.simps(1))
    then have "[x2] \<notin> (\<iota> ` gens)" using inclusion_snd  by metis
    moreover have "wordinverse [x2] = [x1]"  by (metis append_self_conv2 assms(1) inverse_of_inverse wordinverse.simps(1) wordinverse.simps(2))
    ultimately have "genmap (\<iota> ` gens) f [x2] = inv (f [x1])" by (simp add: genmap_def)
    then show ?thesis  using 1 2 a Units_eq Units_r_inv g1 by presburger
  qed
qed

lemma (in group) genmapext_cancels_to:
  assumes "cancels_to x y"
      and "x \<in> freewords_on (gens ::('c, 'd) monoidgentype set)"
      and "y \<in> freewords_on gens"
      and  "f \<in> (\<iota> ` gens) \<rightarrow> carrier G"
  shows "genmapext (\<iota> ` gens) f x = genmapext (\<iota> ` gens) f y"
using assms
unfolding cancels_to_def
proof(induct rule:rtranclp.induct)
  case (rtrancl_refl a)
  then show ?case by auto
  case (rtrancl_into_rtrancl a b c)
obtain c1 x1 x2 c2
      where b: "b = c1 @ x1 # x2 # c2"
      and c: "c = c1 @ c2"
      and i: "inverse x1 = x2"
  using cancels_to_1_unfold rtrancl_into_rtrancl.hyps(3) by blast
  have bin: "b \<in> freewords_on gens" using cancels_to_preserves  cancels_to_def rtrancl_into_rtrancl.prems(1) rtrancl_into_rtrancl.hyps(1)  by metis
  have c1:"c1 \<in> freewords_on gens" using b bin  freewords_on_def leftappend_span by blast
  moreover have fx1:"([x1] @ [x2] @ c2)\<in> freewords_on gens" using b bin  freewords_on_def rightappend_span by fastforce
  moreover then have x1:"[x1] \<in> freewords_on gens" using fx1  freewords_on_def leftappend_span by blast
  moreover  have fx2: "([x2] @ c2) \<in> freewords_on gens" using fx1  freewords_on_def rightappend_span by fastforce
  moreover then have x2:"[x2] \<in> freewords_on gens" using  freewords_on_def leftappend_span by blast
  moreover  have c2: "c2 \<in> freewords_on gens" using fx2  freewords_on_def rightappend_span by fastforce
  ultimately have 2: "genmapext (\<iota> ` gens) f (c1 @ [x1] @ [x2] @ c2) = genmapext (\<iota> ` gens) f c1  \<otimes> (genmapext (\<iota> ` gens) f [x1] \<otimes> genmapext (\<iota> ` gens) f [x2]) \<otimes> genmapext (\<iota> ` gens) f c2" using genmapext_append rtrancl_refl.prems(3) by (smt (z3) genmapext_closed m_assoc m_closed)
  then have "genmapext (\<iota> ` gens) f (c1 @ [x1] @ [x2] @ c2) = genmapext (\<iota> ` gens) f c1  \<otimes> \<one> \<otimes> genmapext (\<iota> ` gens) f c2" using inverse_ext i x1 x2 assms(4) by metis
  then have "genmapext (\<iota> ` gens) f (c1 @ [x1] @ [x2] @ c2) = genmapext (\<iota> ` gens) f c1  \<otimes>  genmapext (\<iota> ` gens) f c2"
    using c1 c2 assms(4) genmapext_closed by (metis l_cancel_one' one_closed)
  then have "genmapext (\<iota> ` gens) f (c1 @ [x1] @ [x2] @ c2) = genmapext (\<iota> ` gens) f (c1@c2)"
    using genmapext_append c1 c2 assms(4) by metis
  then have "genmapext (\<iota> ` gens) f b = genmapext (\<iota> ` gens) f c" using b c by simp
  then show ?case using rtrancl_into_rtrancl by (simp add: bin)
qed

lemma (in group) genmapext_reln_tuple:
  assumes "(x,y) \<in> (reln_tuple (freewords_on (gens ::('c, 'd) monoidgentype set)))"
      and "x \<in> freewords_on gens"
      and "y \<in> freewords_on gens"
      and  "f \<in> (\<iota> ` gens) \<rightarrow> carrier G"
  shows "genmapext (\<iota> ` gens) f x = genmapext (\<iota> ` gens) f y"
proof-
  let ?rx = "iter (length x) reduce x"
  let ?ry = "iter (length y) reduce y"
  have "cancels_to x ?rx" by (simp add: iter_cancels_to)
  moreover then have "?rx  \<in> freewords_on gens" using assms cancels_to_preserves by blast
  ultimately have x:"genmapext (\<iota> ` gens) f x = genmapext (\<iota> ` gens) f ?rx"  using genmapext_cancels_to[of "x" "?rx" "gens" "f"] assms(2) assms(4) by auto
  have  "cancels_to y ?ry" by (simp add: iter_cancels_to)
  moreover then have ryg:"?ry  \<in> freewords_on gens" using assms cancels_to_preserves by blast
  ultimately have y:"genmapext (\<iota> ` gens) f y = genmapext (\<iota> ` gens) f ?ry"  using genmapext_cancels_to[of "y" "?ry" "gens" "f"] assms(3) assms(4) by auto
  have "FreeGroupMain.reln x y" using assms(1) reln_tuple_def assms by (metis (no_types, lifting) case_prodD mem_Collect_eq)
  then have "cancels_eq x y" using reln_imp_cancels by blast
  then have "?rx = ?ry" using cancels_imp_iter by blast
  then show ?thesis using x y by simp
qed

(*
  then have 1:"(symclp cancels_to_1)^** x y" using  eq_symp sympstar by metis
  show ?thesis using 1 assms
  proof(induct rule:rtranclp.induct)
case (rtrancl_refl a)
  then show ?case by simp
next
  case (rtrancl_into_rtrancl a b c)
  then show ?case
    proof(cases "cancels_to b c")
      case True
      then have b:"b \<in> freewords_on gens" using rtrancl_into_rtrancl.prems(1)  reln_tuple_def  sledgehammer
      ultimately have "genmapext f c = genmapext f b"  using genmapext_cancels_to rtrancl_into_rtrancl.prems by blast
      moreover have "genmapext f a = genmapext f b" using b  genmapext_cancels_to rtrancl_into_rtrancl by blast
      ultimately show ?thesis by simp
    next
      case False
      then have "cancels_to c b" using rtrancl_into_rtrancl.hyps(3) cancels_to_1_def by (metis rtrancancel symclp_def)
      moreover then have b:"b \<in> FreeGroupMain.spanset gens" using cancels_to_preserves rtrancl_into_rtrancl.prems(2) by blast
      ultimately have "genmapext f c = genmapext f b"  using genmapext_cancels_to rtrancl_into_rtrancl.prems by blast
      moreover have "genmapext f a = genmapext f b" using b  genmapext_cancels_to rtrancl_into_rtrancl by blast
      ultimately show ?thesis by simp
    qed
next
  case False
  show ?thesis sorry
    qed
qed
qed *)

lemma (in group) congruentlift: assumes "f \<in> (\<iota> ` (S::('c,'d) monoidgentype set)) \<rightarrow> carrier G" shows "congruent (reln_tuple (freewords_on S)) (genmapext (\<iota> ` S) f)"
  unfolding congruent_def
proof-
  have "(\<And>x y. (x, y) \<in> (reln_tuple \<langle>S\<rangle>) \<Longrightarrow> (genmapext (\<iota> ` S) f x) = (genmapext (\<iota> ` S) f y))"
  proof-
    fix x y assume assm: "(x, y) \<in> (reln_tuple \<langle>S\<rangle>)"
    moreover then have "x \<in> \<langle>S\<rangle>" using reln_tuple_def by auto
    moreover have "y \<in> \<langle>S\<rangle>" using reln_tuple_def assm  by auto
    ultimately show "(genmapext (\<iota> ` S) f x) = (genmapext (\<iota> ` S) f y)" using genmapext_reln_tuple assms by blast
  qed
  then show "\<forall>(y, z)\<in>reln_tuple \<langle>S\<rangle>. genmapext (\<iota> ` S) f y = genmapext (\<iota> ` S)  f z" by blast
qed

definition (in group) genmapext_proj where "genmapext_proj S f a = (\<Union>x \<in> a. {genmapext S f x})"

lemma (in group) genmapext_proj_wd:
  assumes " A \<in> quotient \<langle>(S::('c,'d) monoidgentype set)\<rangle> (reln_tuple \<langle>S\<rangle>)"
          "a \<in> A"
          "f \<in> (\<iota> ` S) \<rightarrow> carrier G"
          shows "genmapext_proj (\<iota> ` S) f A = {genmapext (\<iota> ` S) f a}"
proof-
  have "\<forall> x \<in> A . ({genmapext (\<iota> ` S) f x} = {genmapext (\<iota> ` S) f a})"
  proof-
    have "(\<And>x. x \<in> A \<Longrightarrow> ({genmapext (\<iota> ` S) f x} = {genmapext (\<iota> ` S) f a}))"
    proof-
      fix x  assume assm: "x \<in> A"
      then have "(x, a)\<in>reln_tuple \<langle>S\<rangle>" by (meson assms(1) assms(2) quotient_eq_iff reln_equiv)
      then have "genmapext (\<iota> ` S) f x = genmapext (\<iota> ` S) f a"
        using assms(3) congruentlift unfolding congruent_def by blast
      then show "{genmapext (\<iota> ` S) f x} = {genmapext (\<iota> ` S) f a}" by simp
    qed
    then show "\<forall> x \<in> A . ({genmapext (\<iota> ` S) f x} = {genmapext (\<iota> ` S) f a})" by simp
  qed
  then show ?thesis unfolding genmapext_proj_def using assms(2) by blast
qed

definition (in group) genmapext_lift where "genmapext_lift S f a = (THE x. x \<in> genmapext_proj S f a)"

lemma (in group) genmapext_lift_wd:
assumes " A \<in> quotient \<langle>(S::('c,'d) monoidgentype set)\<rangle> (reln_tuple \<langle>S\<rangle>)"
          "a \<in> A"
          "f \<in> (\<iota> ` S) \<rightarrow> carrier G"
        shows "genmapext_lift (\<iota> ` S) f A = genmapext (\<iota> ` S) f a"
  unfolding genmapext_lift_def
proof-
  have "genmapext_proj (\<iota> ` S) f A = {genmapext (\<iota> ` S) f a}" using assms genmapext_proj_wd by blast
  then show "(THE x. x \<in> genmapext_proj (\<iota> ` S) f A) = genmapext (\<iota> ` S) f a"  by simp
qed

lemma (in group) genmapext_lift_hom:
  assumes "f \<in> (\<iota> ` (S::('c,'d) monoidgentype set)) \<rightarrow> carrier G"
  shows "genmapext_lift (\<iota> ` S) f \<in> hom (freegroup S) G"
proof-
  {
  fix x
  assume "x \<in> carrier (freegroup S)"
  then have x2: "x \<in>   quotient \<langle>S\<rangle> (reln_tuple \<langle>S\<rangle>)" unfolding freegroup_def by simp
  moreover then obtain x1 where x1:"x1 \<in> x" by (metis all_not_in_conv in_quotient_imp_non_empty reln_equiv)
  ultimately have xx1: "x = ((reln_tuple \<langle>S\<rangle>)``{x1})"  by (metis (no_types, lifting) Image_singleton_iff equiv_class_eq quotientE reln_equiv)
  then have xin: "x1 \<in> \<langle>S\<rangle>" by (meson in_mono in_quotient_imp_subset reln_equiv x1 x2)
  have "genmapext_lift (\<iota> ` S) f x = genmapext (\<iota> ` S) f x1" using genmapext_lift_wd x2 x1 assms(1)
    by (simp add: genmapext_lift_wd) (* by simp*)
  then have "genmapext_lift (\<iota> ` S) f x \<in> carrier G" using genmapext_closed  assms(1) xin
    by (simp add: genmapext_closed)
}
  moreover
  {
  fix x assume x:"x \<in> carrier (freegroup S)"
  fix y assume y:"y \<in> carrier (freegroup S)"
  have x2:"x \<in>   quotient \<langle>S\<rangle> (reln_tuple \<langle>S\<rangle>)" using freegroup_def x by (metis partial_object.select_convs(1))
  moreover then obtain x1 where x1:"x1 \<in> x" by (metis all_not_in_conv in_quotient_imp_non_empty reln_equiv)
  ultimately have xx1: "x = ((reln_tuple \<langle>S\<rangle>)``{x1})"  by (metis (no_types, lifting) Image_singleton_iff equiv_class_eq quotientE reln_equiv)
  then have xin: "x1 \<in> \<langle>S\<rangle>" by (meson in_mono in_quotient_imp_subset reln_equiv x1 x2)
  have y2:"y \<in>   quotient \<langle>S\<rangle> (reln_tuple \<langle>S\<rangle>)" using freegroup_def y by (metis partial_object.select_convs(1))
  moreover then obtain y1 where y1:"y1 \<in> y" by (metis all_not_in_conv in_quotient_imp_non_empty reln_equiv)
  ultimately have yy1:"y = ((reln_tuple \<langle>S\<rangle>)``{y1})"  by (metis (no_types, lifting) Image_singleton_iff equiv_class_eq quotientE reln_equiv)
  then have yin:"y1 \<in> \<langle>S\<rangle>" by (meson in_mono in_quotient_imp_subset reln_equiv y1 y2)
  have 1:"x \<otimes>\<^bsub>(freegroup S)\<^esub> y = proj_append \<langle>S\<rangle> (x) (y)" by (simp add: freegroup_def)
  then have "x \<otimes>\<^bsub>(freegroup S)\<^esub> y = proj_append \<langle>S\<rangle> ((reln_tuple \<langle>S\<rangle>)``{x1}) ((reln_tuple \<langle>S\<rangle>)``{y1})" using xx1 yy1 by simp
  then have 2:"x \<otimes>\<^bsub>(freegroup S)\<^esub> y = ((reln_tuple \<langle>S\<rangle>)``{x1@y1})" using proj_append_wd x2 y2 x1 y1 reln_equiv by (metis (no_types, lifting)   quotient_eq_iff refl_onD1 reln_refl)
  then have "genmapext_lift (\<iota> ` S) f (x \<otimes>\<^bsub>(freegroup S)\<^esub> y) = genmapext_lift (\<iota> ` S) f ((reln_tuple \<langle>S\<rangle>)``{x1@y1})" by simp
  moreover  have "((reln_tuple \<langle>S\<rangle>)``{x1@y1}) \<in> quotient \<langle>S\<rangle> (reln_tuple \<langle>S\<rangle>)"  by (metis 1 2 proj_append_clos x2 y2)
  moreover have "(x1@y1) \<in> ((reln_tuple \<langle>S\<rangle>)``{x1@y1})" using append_congruent eq_equiv_class equiv_2f_clos reln_equiv x1 x2 y1 y2 by fastforce
  ultimately have "genmapext_lift (\<iota> ` S) f (x \<otimes>\<^bsub>(freegroup S)\<^esub> y) = genmapext (\<iota> ` S) f (x1@y1)" using genmapext_lift_wd[of "((reln_tuple \<langle>S\<rangle>)``{x1@y1})" "S" "(x1@y1)" "f"] using assms by presburger
  then have "genmapext_lift (\<iota> ` S) f (x \<otimes>\<^bsub>(freegroup S)\<^esub> y) = genmapext (\<iota> ` S) f x1 \<otimes> genmapext (\<iota> ` S) f y1" using genmapext_append xin yin assms(1) by auto
  then have "genmapext_lift (\<iota> ` S) f (x \<otimes>\<^bsub>(freegroup S)\<^esub> y) = (genmapext_lift (\<iota> ` S) f x) \<otimes> (genmapext_lift (\<iota> ` S) f y)" using genmapext_lift_wd x2 x1 y2 y1  assms(1)
    by metis
}
  ultimately show ?thesis by (simp add: homI)
qed

definition liftgen where "liftgen S = (\<Union>x \<in> (\<iota> ` S).{reln_tuple \<langle>S\<rangle> ``{x}})"

lemma (in group) unlift_gens: assumes "f \<in> liftgen S \<rightarrow> carrier G"
  shows "unlift f S (liftgen S) \<in> (\<iota> ` (S::('c,'d) monoidgentype set)) \<rightarrow> carrier G"
proof(rule funcsetI)
  fix x assume assm:"x \<in> \<iota> ` S"
  have "(reln_tuple \<langle>S\<rangle> ``{x}) \<in> (\<Union>x \<in> (\<iota> ` (S::('c,'d) monoidgentype set)).{reln_tuple \<langle>S\<rangle> ``{x}} )" using assm by blast
  then have "f (reln_tuple \<langle>S\<rangle> ``{x}) \<in> carrier G" using assms Pi_split_insert_domain unfolding liftgen_def by fastforce
  moreover have "f (reln_tuple \<langle>S\<rangle> ``{x}) = unlift f S (liftgen S) x"  by (simp add: unlift_def)
  ultimately show "unlift f S (liftgen S) x \<in> carrier G" by simp
qed

lemma (in group) genmapext_unlift_hom: assumes
               "f \<in> liftgen (S::('c,'d) monoidgentype set) \<rightarrow> carrier G"
  shows "genmapext_lift (\<iota> ` S) (unlift f S (liftgen S)) \<in> hom (freegroup S) G"
  by (simp add: assms genmapext_lift_hom unlift_gens)

lemma inclusion_subset_spanset:"(\<iota> ` S) \<subseteq> \<langle>S\<rangle>"
proof(rule subsetI)
  fix x assume assms:"x \<in> \<iota> ` S"
  then have "fst (hd x) \<in> S" by (metis fstI image_iff inclusion_def list.sel(1))
  moreover have "snd (hd x) \<in> {True, False}" by simp
  ultimately have "hd x \<in> invgen S" unfolding invgen_def by (simp add: mem_Times_iff)
  moreover have "x = ((hd x)#[])" using assms inclusion_def by (metis image_iff list.sel(1))
  ultimately show "x \<in> \<langle>S\<rangle>" unfolding freewords_on_def using empty gen by metis
qed

lemma liftgen_subset_quotient:"(liftgen S) \<subseteq> quotient \<langle>S\<rangle> (reln_tuple \<langle>S\<rangle>)"
proof(rule subsetI)
  fix x assume assms:"x \<in> liftgen S"
  then have "x \<in> (\<Union>x \<in> (\<iota> ` S).{reln_tuple \<langle>S\<rangle> ``{x}})" by (simp add: liftgen_def)
  then obtain x1 where "x = (reln_tuple \<langle>S\<rangle> ``{x1}) \<and> x1 \<in> (\<iota> ` S)" by blast
  then moreover have "x1 \<in> \<langle>S\<rangle>" using inclusion_subset_spanset by auto
  ultimately show "x \<in> \<langle>S\<rangle> // reln_tuple \<langle>S\<rangle>" by (simp add: quotientI)
qed

lemma inclusion_hd: assumes "x \<in> (\<iota> ` S)"
  shows "(hd x#[]) = x"
proof-
  show ?thesis using assms inclusion_def by (metis image_iff list.sel(1))
qed

lemma (in group) genmapext_unlift_ext:
  assumes "f \<in> liftgen (S::('c,'d) monoidgentype set) \<rightarrow> carrier G"
  shows "\<And>x. x \<in> (liftgen S) \<Longrightarrow> f x = genmapext_lift (\<iota> ` S) (unlift f S (liftgen S)) x"
proof-
  fix x assume assm:"x \<in> (liftgen S)"
  then have x:"x \<in> quotient \<langle>S\<rangle> (reln_tuple \<langle>S\<rangle>)" using liftgen_subset_quotient by auto
  have "x \<in> (\<Union>x \<in> (\<iota> ` S).{reln_tuple \<langle>S\<rangle> ``{x}})" using assm by (simp add: liftgen_def)
  then obtain x1 where x1x:"x = (reln_tuple \<langle>S\<rangle> ``{x1}) \<and> x1 \<in> (\<iota> ` S)" by blast
  then have x1s:"x1 \<in> \<langle>S\<rangle>" using inclusion_subset_spanset by blast
  then have "x1 \<in> x" using reln_tuple_def reln_refl x1x by fastforce
  then have A:"genmapext_lift (\<iota> ` S) (unlift f S (liftgen S)) x = genmapext (\<iota> ` S) (unlift f S (liftgen S)) x1" using  x assms genmapext_lift_wd[of "x" "S" "x1"] by (simp add: unlift_gens)
  have "x1 = (hd x1#[])" using x1x by (metis inclusion_hd)
  then have "genmapext (\<iota> ` S) (unlift f S (liftgen S)) x1 = (genmap (\<iota> ` S) (unlift f S (liftgen S)) x1) \<otimes> \<one>" using genmapext.simps by metis
  then have "genmapext (\<iota> ` S) (unlift f S (liftgen S)) x1 = (genmap (\<iota> ` S) (unlift f S (liftgen S)) x1)" using genmap_closed[of "(unlift f S (liftgen S))" "S" "x1"] unlift_gens[of "f" "S"] assms by (simp add: x1x)
  then have "genmapext (\<iota> ` S) (unlift f S (liftgen S)) x1 = (unlift f S (liftgen S)) x1" using x1x unfolding genmap_def by simp
  then have "genmapext (\<iota> ` S) (unlift f S (liftgen S)) x1 = f x" using  x1x by (simp add: unlift_def)
  then show "f x = genmapext_lift (\<iota> ` S) (unlift f S (liftgen S)) x" using A by simp
qed

lemma (in group) span_liftgen: "\<langle>liftgen S\<rangle>\<^bsub>(freegroup S)\<^esub>  \<subseteq> carrier (freegroup S)"
proof-
  have "carrier (freegroup S) = quotient \<langle>S\<rangle> (reln_tuple \<langle>S\<rangle>)" by (simp add: freegroup_def)
  moreover have "(liftgen S)  \<subseteq> quotient \<langle>S\<rangle> (reln_tuple \<langle>S\<rangle>)" by (simp add: liftgen_subset_quotient)
  ultimately show ?thesis by (metis freegroup_is_group group.gen_span_closed)
qed

lemma invgen_elem: assumes "x \<in> invgen S" shows "[x] \<in> (\<iota> ` S) \<or> wordinverse [x] \<in> (\<iota> ` S)"
 proof(cases "snd x = True")
   case True
   moreover have fx:"fst x \<in> S" using assms invgen_def[of "S"] by (metis mem_Sigma_iff prod.collapse)
  ultimately have "[x] \<in> (\<iota> ` S)" using assms fx inclusion_def  by (metis (mono_tags, lifting) image_iff prod.collapse)
  then show "[x] \<in> (\<iota> ` S) \<or> wordinverse [x] \<in> (\<iota> ` S)"  by blast
next
  case False
  then have "snd x = False" using assms by auto
  moreover have "wordinverse [x] = (inverse x)#[]" by simp
moreover have fx:"fst x \<in> S" using assms invgen_def[of "S"] by (metis mem_Sigma_iff prod.collapse)
  ultimately have "wordinverse [x] \<in> (\<iota> ` S)" using inverse.simps(2) assms fx inclusion_def  by (metis (mono_tags, lifting) image_iff prod.collapse)
  then show "[x] \<in> (\<iota> ` S) \<or> wordinverse [x] \<in> (\<iota> ` S)" by blast
qed

lemma (in group) wordinverse_inv:
  assumes "x \<in> carrier (freegroup S)" "x = (reln_tuple \<langle>S\<rangle>) `` {x1}"
  shows "inv\<^bsub>(freegroup S)\<^esub> x = (reln_tuple \<langle>S\<rangle>) `` {wordinverse x1}"
proof-
  have nil: "[] \<in> \<langle>S\<rangle>"  by (simp add: freewords_on_def words_on.empty)
  have 1:"x1 \<in> \<langle>S\<rangle>" using assms unfolding freegroup_def using in_quotient_imp_non_empty refl_onD1 reln_equiv reln_refl by fastforce
  then have 2:"wordinverse x1 \<in> \<langle>S\<rangle>"  by (simp add: span_wordinverse)
  then have A:"(reln_tuple \<langle>S\<rangle>) `` {wordinverse x1} \<in> carrier (freegroup S)" unfolding freegroup_def by (simp add: quotientI)
  have "x \<otimes>\<^bsub>(freegroup S)\<^esub> (reln_tuple \<langle>S\<rangle>) `` {wordinverse x1} = (proj_append \<langle>S\<rangle>) ((reln_tuple \<langle>S\<rangle>) `` {x1}) ((reln_tuple \<langle>S\<rangle>) `` {wordinverse x1})" using assms  by (simp add: freegroup_def)
  then have "x \<otimes>\<^bsub>(freegroup S)\<^esub> (reln_tuple \<langle>S\<rangle>) `` {wordinverse x1} = ((reln_tuple \<langle>S\<rangle>) `` {x1@wordinverse x1})" using proj_append_wd by (simp add: proj_append_wd 1 2)
  moreover have "x1@(wordinverse x1) \<in> \<langle>S\<rangle>" using 1 2 span_append freewords_on_def by blast
  moreover then have "((x1@(wordinverse x1)), []) \<in> reln_tuple \<langle>S\<rangle>" using nil wordinverse_inverse reln_tuple_def by auto
  moreover then have "reln_tuple \<langle>S\<rangle> `` {x1@(wordinverse x1)} = reln_tuple \<langle>S\<rangle> `` {[]}" by (metis equiv_class_eq reln_equiv)
  ultimately have "x \<otimes>\<^bsub>(freegroup S)\<^esub> (reln_tuple \<langle>S\<rangle>) `` {wordinverse x1} = reln_tuple \<langle>S\<rangle> `` {[]}" by simp
  then have B:"x \<otimes>\<^bsub>(freegroup S)\<^esub> (reln_tuple \<langle>S\<rangle>) `` {wordinverse x1} = \<one>\<^bsub>(freegroup S)\<^esub>" by (simp add: freegroup_def)
  have " (reln_tuple \<langle>S\<rangle>) `` {wordinverse x1}  \<otimes>\<^bsub>(freegroup S)\<^esub> x = (proj_append \<langle>S\<rangle>) ((reln_tuple \<langle>S\<rangle>) `` {wordinverse x1}) ((reln_tuple \<langle>S\<rangle>) `` {x1})"  using assms  by (simp add: freegroup_def)
  then moreover have "proj_append \<langle>S\<rangle>  ((reln_tuple \<langle>S\<rangle>)``{wordinverse x1}) ((reln_tuple \<langle>S\<rangle>)``{x1}) = reln_tuple \<langle>S\<rangle> `` {(wordinverse x1)@x1}"  by (simp add: 1 2 proj_append_wd)
  moreover have "(wordinverse x1)@x1 \<in> \<langle>S\<rangle>" using 1 2 span_append freewords_on_def by blast
  moreover then have "(((wordinverse x1)@x1), []) \<in> reln_tuple \<langle>S\<rangle>" using nil inverse_wordinverse reln_tuple_def by auto
  moreover then have "reln_tuple \<langle>S\<rangle> `` {(wordinverse x1)@x1} = reln_tuple \<langle>S\<rangle> `` {[]}" by (metis equiv_class_eq reln_equiv)
  ultimately have C:"(reln_tuple \<langle>S\<rangle>) `` {wordinverse x1}  \<otimes>\<^bsub>(freegroup S)\<^esub> x = \<one>\<^bsub>(freegroup S)\<^esub>" by (simp add: freegroup_def)
  show ?thesis by (simp add: A C assms(1) freegroup_is_group group.inv_equality inv_unique r_inv)
qed

lemma inclusion_liftgen: assumes "x \<in> (\<iota> ` S)" shows "(reln_tuple \<langle>S\<rangle> `` {x}) \<in> liftgen S"
  using assms unfolding liftgen_def
proof-
  fix x assume "x \<in> \<iota> ` S"
  then show "reln_tuple \<langle>S\<rangle> `` {x} \<in> (\<Union>x\<in>\<iota> ` S. {reln_tuple \<langle>S\<rangle> `` {x}})" by blast
qed

lemma (in group) liftgen_span: "carrier (freegroup S) \<subseteq> \<langle>liftgen S\<rangle>\<^bsub>(freegroup S)\<^esub>"
proof(rule subsetI)
  fix x assume assm: "x \<in> carrier (freegroup S)"
  have "carrier (freegroup S) = quotient \<langle>S\<rangle> (reln_tuple \<langle>S\<rangle>)" by (simp add: freegroup_def)
  then have x:"x \<in> quotient \<langle>S\<rangle> (reln_tuple \<langle>S\<rangle>)" using assm by simp
  then show "x \<in> \<langle>liftgen S\<rangle>\<^bsub>freegroup S\<^esub>"
  proof(cases "x = \<one>\<^bsub>freegroup S\<^esub>")
case True
  then show ?thesis by simp
next
  case False
  then obtain x1 where def:"x = (reln_tuple \<langle>S\<rangle> ``{x1}) \<and> (x1 \<in> \<langle>S\<rangle>)"  by (meson x quotientE)
  then have "(x1 \<in> \<langle>S\<rangle>)" by simp
  then have "(reln_tuple \<langle>S\<rangle> ``{x1}) \<in> \<langle>liftgen S\<rangle>\<^bsub>freegroup S\<^esub>"
  proof(induction x1)
    case Nil
    have "\<one>\<^bsub>freegroup S\<^esub> = reln_tuple \<langle>S\<rangle> `` {[]}" by (simp add: freegroup_def)
  then show ?case  by (metis gen_span.gen_one)
next
  case (Cons a x1)
  then have a: "[a] \<in> \<langle>S\<rangle>" using Cons cons_span  freewords_on_def by blast
  moreover have c1:"x1  \<in> \<langle>S\<rangle>" using Cons span_cons  freewords_on_def by blast
  ultimately have wd:"reln_tuple \<langle>S\<rangle> `` {a # x1} = (proj_append \<langle>S\<rangle>) (reln_tuple \<langle>S\<rangle> `` {[a]})  (reln_tuple \<langle>S\<rangle> `` {x1})"  by (simp add: proj_append_wd)
  have x1in:"reln_tuple \<langle>S\<rangle> `` {x1} \<in> \<langle>liftgen S\<rangle>\<^bsub>freegroup S\<^esub>" using Cons by (simp add: c1)
  have "wordinverse [a] \<in> \<langle>S\<rangle>" using a span_wordinverse by blast
  then have inva: "reln_tuple \<langle>S\<rangle> `` {wordinverse [a]} \<in> carrier (freegroup S)" using freegroup_def by (simp add: freegroup_def quotientI)
  have invgen:"a \<in> (invgen S)" using a by (metis words_on.cases list.inject not_Cons_self2 freewords_on_def)
  then show ?case
  proof(cases "[a]  \<in> (\<iota> ` S)")
    case True
    then have "(reln_tuple \<langle>S\<rangle> `` {[a]}) \<in> liftgen S" by (simp add: inclusion_liftgen)
    then have "(reln_tuple \<langle>S\<rangle> `` {[a]}) \<in> \<langle>liftgen S\<rangle>\<^bsub>(freegroup S)\<^esub>"  by (simp add: gen_span.gen_gens)
    then have "(proj_append \<langle>S\<rangle>) (reln_tuple \<langle>S\<rangle> `` {[a]})  (reln_tuple \<langle>S\<rangle> `` {x1}) \<in> \<langle>liftgen S\<rangle>\<^bsub>(freegroup S)\<^esub>" using freegroup_def x1in gen_mult[of "(reln_tuple \<langle>S\<rangle> `` {[a]})" "freegroup S" "liftgen S" "(reln_tuple \<langle>S\<rangle> `` {x1})"] by (metis monoid.select_convs(1))
    then show ?thesis using wd by simp
next
  case False
  then have "wordinverse [a] \<in> \<iota> ` S" using invgen invgen_elem by blast
  then have "(reln_tuple \<langle>S\<rangle> `` {wordinverse [a]}) \<in> liftgen S" by (simp add: inclusion_liftgen)
  then have 1: "(reln_tuple \<langle>S\<rangle> `` {wordinverse [a]}) \<in> \<langle>liftgen S\<rangle>\<^bsub>(freegroup S)\<^esub>"  by (simp add: gen_span.gen_gens)
  have "wordinverse (wordinverse [a]) = [a]"  using wordinverse_of_wordinverse by blast
  then have "inv\<^bsub>(freegroup S)\<^esub> (reln_tuple \<langle>S\<rangle> `` {wordinverse [a]}) = (reln_tuple \<langle>S\<rangle> `` { [a]})" using inva wordinverse_inv[of "(reln_tuple \<langle>S\<rangle> `` {wordinverse [a]})" "S" "wordinverse [a]"] by auto
  then have "(reln_tuple \<langle>S\<rangle> `` { [a]}) \<in> \<langle>liftgen S\<rangle>\<^bsub>(freegroup S)\<^esub>" using 1  by (metis gen_span.gen_inv)
  then have "(proj_append \<langle>S\<rangle>) (reln_tuple \<langle>S\<rangle> `` {[a]})  (reln_tuple \<langle>S\<rangle> `` {x1}) \<in> \<langle>liftgen S\<rangle>\<^bsub>(freegroup S)\<^esub>" using freegroup_def x1in gen_mult[of "(reln_tuple \<langle>S\<rangle> `` {[a]})" "freegroup S" "liftgen S" "(reln_tuple \<langle>S\<rangle> `` {x1})"] by (metis monoid.select_convs(1))
  then show ?thesis using wd by simp
qed
qed
  then show ?thesis using def by simp
qed
qed

lemma (in group) genmapext_unlift_uni:
  assumes "group G"
  and "f  \<in> liftgen (S::('c,'d) monoidgentype set) \<rightarrow> carrier G"
  and "h \<in> hom (freegroup S) G"
  and "\<forall> x \<in> (liftgen S) . f x = h x"
shows "\<forall>y \<in> carrier (freegroup S).  (genmapext_lift (\<iota> ` S) (unlift f S (liftgen S))) y = h y"
proof-
  have 1:"group (freegroup S)" by (simp add: freegroup_is_group)
  have "\<forall> x \<in> (liftgen S) . f x = (genmapext_lift (\<iota> ` S) (unlift f S (liftgen S))) x" using genmapext_unlift_ext assms(2) by blast
  then have "\<forall> x \<in> (liftgen S) . (genmapext_lift (\<iota> ` S) (unlift f S (liftgen S))) x = h x" using assms(4) by auto
  moreover have "(liftgen S) \<subseteq> carrier (freegroup S)" by (simp add: freegroup_def liftgen_subset_quotient)
  moreover have "(genmapext_lift (\<iota> ` S) (unlift f S (liftgen S))) \<in> hom (freegroup S) G" using assms(2) by (simp add: genmapext_unlift_hom)
  ultimately have "\<forall>x \<in> \<langle>(liftgen S)\<rangle>\<^bsub>(freegroup S)\<^esub>. (genmapext_lift (\<iota> ` S) (unlift f S (liftgen S))) x = h x" using hom_unique_on_span assms 1 by blast
  then show ?thesis  using liftgen_span by blast
qed

end


(*
    This file is a part of IsarMathLib -
    a library of formalized mathematics for Isabelle/Isar.

    Copyright (C) 2008-2014  Slawomir Kolodynski

    This program is free software; Redistribution and use in source and binary forms,
    with or without modification, are permitted provided that the following conditions are met:

   1. Redistributions of source code must retain the above copyright notice,
   this list of conditions and the following disclaimer.
   2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation and/or
   other materials provided with the distribution.
   3. The name of the author may not be used to endorse or promote products
   derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

*)

section \<open>Introduction to the IsarMathLib project\<close>

theory Introduction imports ZF.equalities

begin

text\<open>This theory does not contain any formalized mathematics used in
  other theories, but is an introduction to IsarMathLib project.\<close>

subsection\<open>How to read IsarMathLib proofs - a tutorial\<close>

text\<open>Isar (the Isabelle's formal proof language) was designed to be similar
  to the standard language of mathematics. Any person able to read proofs in
  a typical mathematical paper should be able to read and understand
  Isar proofs without having to learn a special proof language.
  However, Isar is a formal proof language and as such it does contain a
  couple of constructs whose meaning is hard to guess. In this tutorial
  we will define a notion and prove an example theorem about that notion,
  explaining Isar syntax along the way. This tutorial may also serve as a
  style guide for IsarMathLib contributors. Note that this tutorial
  aims to help in reading the presentation of the Isar language that is used
  in IsarMathLib proof document and HTML rendering on the
  FormalMath.org site, but does not teach how to write proofs that can be
  verified by Isabelle. This presentation is different than the source
  processed by Isabelle (the concept that the source and presentation
  look different should be familiar to any LaTeX user). To learn
  how to write Isar proofs one needs to study the source of this tutorial as well.\<close>

text\<open>The first thing that mathematicians typically do is to define
  notions. In Isar this is done with the \<open>definition\<close> keyword.
  In our case we define a notion of two
  sets being disjoint. We will use the infix notation, i.e. the string
  \<open>{is disjoint with}\<close> put between two sets to denote our notion
  of disjointness.
  The left side of the \<open>\<equiv>\<close> symbol is the notion
  being defined, the right side says how we define it. In Isabelle/ZF \<open>0\<close>
  is used to denote both zero (of natural numbers) and the empty set, which is
  not surprising as those two things are the same in set theory.\<close>

definition
  AreDisjoint (infix "{is disjoint with}" 90) where
  "A {is disjoint with} B \<equiv> A \<inter> B = 0"

text\<open>We are ready to prove a theorem. Here we show that the relation
  of being disjoint is symmetric. We start with one of the keywords
  ''theorem'', ''lemma'' or ''corollary''. In Isar they are synonymous.
  Then we provide a name for the theorem. In standard mathematics
  theorems are numbered. In Isar we can do that too, but it is
  considered better to give theorems meaningful names.
  After the ''shows'' keyword we give the statement to show. The
  \<open>\<longleftrightarrow>\<close> symbol denotes the equivalence in Isabelle/ZF. Here
  we want to show that "A is disjoint with B iff and only if B is disjoint
  with A". To prove this fact we show two implications - the first one that
  \<open>A {is disjoint with} B\<close> implies \<open>B {is disjoint with} A\<close>
  and then the converse one. Each of these implications is formulated
  as a statement to be proved and then proved in
  a subproof like a mini-theorem.
  Each subproof uses a proof block to show the implication. Proof blocks
  are delimited with curly brackets in Isar.
  Proof block is one of the constructs that
  does not exist in informal mathematics, so it may be confusing.
  When reading a proof containing a proof block I suggest to focus first
  on what is that we are proving in it. This can be done by looking
  at the first line or two of the block and then at the last statement.
  In our case the block starts with
  "assume \<open>A {is disjoint with} B\<close> and the last statement
  is "then have \<open>B {is disjoint with} A\<close>". It is a typical pattern
  when someone needs to prove an implication: one assumes the antecedent
  and then shows that the consequent follows from this assumption.
  Implications are denoted with the
  \<open>\<longrightarrow>\<close> symbol in Isabelle.
  After we prove both implications we collect them
  using the ''moreover'' construct. The keyword ''ultimately''
  indicates that what follows is the conclusion of the statements
  collected with ''moreover''. The ''show'' keyword is like ''have'',
  except that it indicates that we have arrived at the claim of the
  theorem (or a subproof).\<close>

theorem disjointness_symmetric:
  shows "A {is disjoint with} B \<longleftrightarrow> B {is disjoint with} A"
proof -
  have "A {is disjoint with} B \<longrightarrow> B {is disjoint with} A"
  proof -
    { assume "A {is disjoint with} B"
      then have "A \<inter> B = 0" using AreDisjoint_def by simp
      hence "B \<inter> A = 0" by auto
      then have  "B {is disjoint with} A"
        using AreDisjoint_def by simp
    } thus ?thesis by simp
  qed
  moreover have "B {is disjoint with} A \<longrightarrow> A {is disjoint with} B"
  proof -
    { assume "B {is disjoint with} A"
      then have "B \<inter> A = 0" using AreDisjoint_def by simp
      hence "A \<inter> B = 0" by auto
      then have  "A {is disjoint with} B"
        using AreDisjoint_def by simp
    } thus ?thesis by simp
  qed
  ultimately show ?thesis by blast
qed

subsection\<open>Overview of the project\<close>

text\<open>
  The  \<open>Fol1\<close>, \<open> ZF1\<close> and \<open>Nat_ZF_IML\<close> theory
  files contain some background material that is needed for
  the remaining theories.

  \<open>Order_ZF\<close> and \<open>Order_ZF_1a\<close> reformulate
  material from standard Isabelle's
  \<open>Order\<close> theory in terms of non-strict (less-or-equal)
  order relations.
  \<open>Order_ZF_1\<close> on the other hand directly continues the \<open>Order\<close>
  theory file using strict order relations (less and not equal). This is useful
  for translating theorems from Metamath.

  In \<open>NatOrder_ZF\<close> we prove that the usual order on natural numbers
  is linear.

  The \<open>func1\<close> theory provides basic facts about functions.
  \<open>func_ZF\<close> continues this development with more advanced
  topics that relate to algebraic properties of binary operations,
  like lifting a binary operation to a function space,
  associative, commutative and distributive operations and properties
  of functions related to order relations. \<open>func_ZF_1\<close> is
  about properties of functions related to order relations.

  The standard Isabelle's \<open>Finite\<close> theory defines the finite
  powerset of a set as a certain "datatype" (?) with some recursive
  properties. IsarMathLib's \<open>Finite1\<close>
  and  \<open>Finite_ZF_1\<close> theories develop more facts about this notion.
  These two theories are obsolete now.
  They will be gradually replaced by an approach based on set theory
  rather than tools specific to Isabelle. This approach is presented
  in \<open>Finite_ZF\<close> theory file.

  In \<open>FinOrd_ZF\<close> we talk about ordered finite sets.

  The \<open>EquivClass1\<close> theory file is a reformulation of
  the material in the standard
  Isabelle's \<open>EquivClass\<close> theory in the spirit of ZF set theory.

  \<open>FiniteSeq_ZF\<close> discusses the notion of finite sequences
  (a.k.a. lists).

  \<open>InductiveSeq_ZF\<close> provides the definition and properties of
  (what is known in basic calculus as) sequences defined by induction,
  i. e. by a formula of the form $a_0 = x,\ a_{n+1} = f(a_n)$.

  \<open>Fold_ZF\<close> shows how the familiar from functional
  programming notion of fold can be interpreted in set theory.

  \<open>Partitions_ZF\<close> is about splitting a set into non-overlapping
  subsets. This is a common trick in proofs.

  \<open>Semigroup_ZF\<close> treats the expressions of the form
  $a_0\cdot a_1\cdot .. \cdot a_n$, (i.e. products of finite sequences),
  where "$\cdot$" is an associative binary operation.

  \<open>CommutativeSemigroup_ZF\<close> is another take on a similar subject.
  This time we consider the case when the operation is commutative
  and the result of depends only on the set of elements we are
  summing (additively speaking), but not the order.

  The \<open>Topology_ZF\<close> series covers basics of general topology:
  interior, closure, boundary, compact sets, separation axioms and
  continuous functions.

  \<open>Group_ZF\<close>, \<open>Group_ZF_1\<close>, \<open>Group_ZF_1b\<close>
  and \<open>Group_ZF_2\<close>
  provide basic facts of the group theory. \<open>Group_ZF_3\<close>
  considers the notion of almost homomorphisms that is nedeed for the
  real numbers construction in \<open>Real_ZF\<close>.

  The \<open>TopologicalGroup\<close> connects the \<open>Topology_ZF\<close> and
  \<open>Group_ZF\<close> series and starts the subject of topological groups
  with some basic definitions and facts.

  In \<open>DirectProduct_ZF\<close> we define direct product of groups and show
  some its basic properties.

  The \<open>OrderedGroup_ZF\<close> theory treats ordered groups.
  This is a suprisingly large theory for such relatively obscure topic.

  \<open>Ring_ZF\<close> defines rings. \<open>Ring_ZF_1\<close> covers
  the properties of rings that are specific to the real numbers construction
  in \<open>Real_ZF\<close>.

  The \<open>OrderedRing_ZF\<close> theory looks at the consequences of adding
  a linear order to the ring algebraic structure.

  \<open>Field_ZF\<close> and \<open>OrderedField_ZF\<close> contain basic facts
  about (you guessed it) fields and ordered fields.

  \<open>Int_ZF_IML\<close> theory considers the integers
  as a monoid (multiplication) and an abelian ordered group (addition).
  In \<open>Int_ZF_1\<close> we show that integers form a commutative ring.
  \<open>Int_ZF_2\<close> contains some facts about slopes (almost homomorphisms
  on integers) needed for real numbers construction,
  used in \<open>Real_ZF_1\<close>.

  In the \<open>IntDiv_ZF_IML\<close> theory we translate some properties of the
  integer quotient and reminder functions studied in the standard Isabelle's
  \<open>IntDiv_ZF\<close> theory to the notation used in IsarMathLib.

  The \<open>Real_ZF\<close> and \<open>Real_ZF_1\<close> theories
  contain the construction of real numbers based on the paper \cite{Arthan2004}
  by R. D. Arthan (not Cauchy sequences, not Dedekind sections).
  The heavy lifting
  is done mostly in \<open>Group_ZF_3\<close>, \<open>Ring_ZF_1\<close>
  and \<open>Int_ZF_2\<close>. \<open>Real_ZF\<close> contains
  the part of the construction that can be done
  starting from generic abelian groups (rather than additive group of integers).
  This allows to show that real numbers form a ring.
  \<open>Real_ZF_1\<close> continues the construction using properties specific
  to the integers and showing that real numbers constructed this way
  form a complete ordered field.

 \<open>Cardinal_ZF\<close> provides a couple of theorems about cardinals that are mostly used for studying
 properties of topological properties (yes, this is kind of meta).
 The main result (proven without AC) is that if two sets can be injectively mapped into an
 infinite cardinal, then so can be their union.
 There is also a definition of the Axiom of Choice specific for a given cardinal
 (so that the choice function exists for families of sets of given cardinality).
 Some properties are proven for such predicates, like that for finite families of sets the choice
 function always exists (in ZF) and that the axiom of choice for a larger cardinal implies
 one for a smaller cardinal.

 \<open>Group_ZF_4\<close> considers conjugate of subgroup and defines simple groups.
 A nice theorem here is that endomorphisms of an abelian group form a ring.
 The first isomorphism theorem (a group homomorphism $h$ induces an isomorphism between the group
 divided by the kernel of $h$ and the image of $h$) is proven.

 Turns out given a property of a topological space one can define a local version of a property in general.
 This is studied in the the \<open>Topology_ZF_properties_2\<close> theory and applied to local
 versions of the property of being finite or compact or Hausdorff
 (i.e. locally finite, locally compact, locally Hausdorff).
 There are a couple of nice applications, like one-point compactification that allows to show
 that every locally compact Hausdorff space is regular.
 Also there are some results on the interplay between hereditability of a property and local properties.

  For a given surjection $f : X\rightarrow Y$, where $X$ is a topological space one can consider the
  weakest topology on $Y$ which makes $f$ continuous, let's call it a quotient topology generated by $f$.
  The quotient topology generated by an equivalence relation r on X is actually a special case
  of this setup, where $f$ is the natural projection of $X$ on the quotient $X/r$.
  The properties of these two ways of getting new topologies are studied in \<open>Topology_ZF_8\<close>
  theory. The main result is that any quotient topology generated by a function is homeomorphic
  to a topology given by an equivalence relation, so these two approaches to quotient
  topologies are kind of equivalent.

  As we all know, automorphisms of a topological space form a group. This fact is proven in \<open>Topology_ZF_9\<close>
  and the automorphism groups for co-cardinal, included-set, and excluded-set topologies are identified.
  For order topologies it is shown that order isomorphisms are homeomorphisms of the topology induced by the order.
  Properties preserved by continuous functions are studied and as an application it is shown
  for example that quotient topological spaces of compact (or connected) spaces are compact (or connected, resp.)

  The \<open>Topology_ZF_10\<close> theory is about products of two topological spaces.
  It is proven that if two spaces are $T_0$ (or $T_1$, $T_2$, regular, connected) then their product is as well.

  Given a total order on a set one can define a natural topology on it generated by taking the rays
  and intervals as the base. The  \<open>Topology_ZF_11\<close> theory studies relations between the order
  and various properties of generated topology. For example one can show that if the order topology
  is connected, then the order is complete (in the sense that for each set bounded from above the
  set of upper bounds has a minimum). For a given cardinal $\kappa$ we can consider
  generalized notion of $\kappa-separability$. Turns out $\kappa$-separability is related to (order)
  density of sets of cardinality $\kappa$ for order topologies.

  Being a topological group imposes additional structure on the topology of the group, in particular
  its separation properties. In \<open>Topological_Group_ZF_1.thy\<close> theory it is shown that if
  a topology is $T_0$, then it must be $T_3$ , and that the topology in a topological group
  is always regular.

  For a given normal subgroup of a topological group we can define a topology on the quotient
  group in a natural way. At the end of the \<open>Topological_Group_ZF_2.thy\<close> theory it is shown
  that such topology on the quotient group makes it a topological group.

  The \<open>Topological_Group_ZF_3.thy\<close> theory studies the topologies on subgroups of a
  topological group. A couple of nice basic properties are shown, like that the closure of a
  subgroup is a subgroup, closure of a normal subgroup is normal and, a bit more surprising
  (to me) property that every locally-compact subgroup of a $T_0$ group is closed.

  In \<open>Complex_ZF\<close> we construct complex numbers starting from
  a complete ordered field (a model of real numbers). We also define
  the notation for writing about complex numbers and prove that the
  structure of complex numbers constructed there satisfies the axioms
  of complex numbers used in Metamath.

  \<open>MMI_prelude\<close> defines the \<open>mmisar0\<close> context in which
  most theorems translated from Metamath are proven. It also contains a
  chapter explaining how the translation works.

  In the \<open>Metamath_interface\<close> theory we prove a theorem
  that the \<open>mmisar0\<close> context is valid (can be used)
  in the \<open>complex0\<close> context.
  All theories using the translated results will import the
  \<open>Metamath_interface\<close> theory. The \<open>Metamath_sampler\<close>
  theory provides some examples of using the translated theorems
  in the \<open>complex0\<close> context.

  The theories \<open>MMI_logic_and_sets\<close>, \<open>MMI_Complex\<close>,
  \<open>MMI_Complex_1\<close> and \<open>MMI_Complex_2\<close>
  contain the theorems imported from the
  Metamath's set.mm database. As the translated proofs are rather verbose
  these theories are not printed in this proof document.
  The full list of translated facts can be found in the
  \<open>Metamath_theorems.txt\<close> file included in the
  IsarMathLib distribution.
  The \<open>MMI_examples\<close> provides some theorems imported from Metamath
  that are printed in this proof document as examples of how translated
  proofs look like.\<close>

end