(*  Title:      ZF/UNITY/Follows.thy
    Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
    Copyright   2002  University of Cambridge

Theory ported from HOL.
*)

section\<open>The "Follows" relation of Charpentier and Sivilotte\<close>

theory Follows imports SubstAx Increasing begin

definition
  Follows :: "[i, i, i=>i, i=>i] => i"  where
  "Follows(A, r, f, g) ==
            Increasing(A, r, g) Int
            Increasing(A, r,f) Int
            Always({s \<in> state. <f(s), g(s)>:r}) Int
           (\<Inter>k \<in> A. {s \<in> state. <k, g(s)>:r} \<longmapsto>w {s \<in> state. <k,f(s)>:r})"

abbreviation
  Incr :: "[i=>i]=>i" where
  "Incr(f) == Increasing(list(nat), prefix(nat), f)"

abbreviation
  n_Incr :: "[i=>i]=>i" where
  "n_Incr(f) == Increasing(nat, Le, f)"

abbreviation
  s_Incr :: "[i=>i]=>i" where
  "s_Incr(f) == Increasing(Pow(nat), SetLe(nat), f)"

abbreviation
  m_Incr :: "[i=>i]=>i" where
  "m_Incr(f) == Increasing(Mult(nat), MultLe(nat, Le), f)"

abbreviation
  n_Fols :: "[i=>i, i=>i]=>i"   (infixl \<open>n'_Fols\<close> 65)  where
  "f n_Fols g == Follows(nat, Le, f, g)"

abbreviation
  Follows' :: "[i=>i, i=>i, i, i] => i"
        (\<open>(_ /Fols _ /Wrt (_ /'/ _))\<close> [60, 0, 0, 60] 60)  where
  "f Fols g Wrt r/A == Follows(A,r,f,g)"

(*Does this hold for "invariant"?*)

lemma Follows_cong:
     "[|A=A'; r=r'; !!x. x \<in> state ==> f(x)=f'(x); !!x. x \<in> state ==> g(x)=g'(x)|] ==> Follows(A, r, f, g) = Follows(A', r', f', g')"
by (simp add: Increasing_def Follows_def)

lemma subset_Always_comp:
"[| mono1(A, r, B, s, h); \<forall>x \<in> state. f(x):A & g(x):A |] ==>
   Always({x \<in> state. <f(x), g(x)> \<in> r})<=Always({x \<in> state. <(h comp f)(x), (h comp g)(x)> \<in> s})"
apply (unfold mono1_def metacomp_def)
apply (auto simp add: Always_eq_includes_reachable)
done

lemma imp_Always_comp:
"[| F \<in> Always({x \<in> state. <f(x), g(x)> \<in> r});
    mono1(A, r, B, s, h); \<forall>x \<in> state. f(x):A & g(x):A |] ==>
    F \<in> Always({x \<in> state. <(h comp f)(x), (h comp g)(x)> \<in> s})"
by (blast intro: subset_Always_comp [THEN subsetD])

lemma imp_Always_comp2:
"[| F \<in> Always({x \<in> state. <f1(x), f(x)> \<in> r});
    F \<in> Always({x \<in> state. <g1(x), g(x)> \<in> s});
    mono2(A, r, B, s, C, t, h);
    \<forall>x \<in> state. f1(x):A & f(x):A & g1(x):B & g(x):B |]
  ==> F \<in> Always({x \<in> state. <h(f1(x), g1(x)), h(f(x), g(x))> \<in> t})"
apply (auto simp add: Always_eq_includes_reachable mono2_def)
apply (auto dest!: subsetD)
done

(* comp LeadsTo *)

lemma subset_LeadsTo_comp:
"[| mono1(A, r, B, s, h); refl(A,r); trans[B](s);
        \<forall>x \<in> state. f(x):A & g(x):A |] ==>
  (\<Inter>j \<in> A. {s \<in> state. <j, g(s)> \<in> r} \<longmapsto>w {s \<in> state. <j,f(s)> \<in> r}) <=
 (\<Inter>k \<in> B. {x \<in> state. <k, (h comp g)(x)> \<in> s} \<longmapsto>w {x \<in> state. <k, (h comp f)(x)> \<in> s})"

apply (unfold mono1_def metacomp_def, clarify)
apply (simp_all (no_asm_use) add: INT_iff)
apply auto
apply (rule single_LeadsTo_I)
prefer 2 apply (blast dest: LeadsTo_type [THEN subsetD], auto)
apply (rotate_tac 5)
apply (drule_tac x = "g (sa) " in bspec)
apply (erule_tac [2] LeadsTo_weaken)
apply (auto simp add: part_order_def refl_def)
apply (rule_tac b = "h (g (sa))" in trans_onD)
apply blast
apply auto
done

lemma imp_LeadsTo_comp:
"[| F:(\<Inter>j \<in> A. {s \<in> state. <j, g(s)> \<in> r} \<longmapsto>w {s \<in> state. <j,f(s)> \<in> r});
    mono1(A, r, B, s, h); refl(A,r); trans[B](s);
    \<forall>x \<in> state. f(x):A & g(x):A |] ==>
   F:(\<Inter>k \<in> B. {x \<in> state. <k, (h comp g)(x)> \<in> s} \<longmapsto>w {x \<in> state. <k, (h comp f)(x)> \<in> s})"
apply (rule subset_LeadsTo_comp [THEN subsetD], auto)
done

lemma imp_LeadsTo_comp_right:
"[| F \<in> Increasing(B, s, g);
  \<forall>j \<in> A. F: {s \<in> state. <j, f(s)> \<in> r} \<longmapsto>w {s \<in> state. <j,f1(s)> \<in> r};
  mono2(A, r, B, s, C, t, h); refl(A, r); refl(B, s); trans[C](t);
  \<forall>x \<in> state. f1(x):A & f(x):A & g(x):B; k \<in> C |] ==>
  F:{x \<in> state. <k, h(f(x), g(x))> \<in> t} \<longmapsto>w {x \<in> state. <k, h(f1(x), g(x))> \<in> t}"
apply (unfold mono2_def Increasing_def)
apply (rule single_LeadsTo_I, auto)
apply (drule_tac x = "g (sa) " and A = B in bspec)
apply auto
apply (drule_tac x = "f (sa) " and P = "%j. F \<in> X(j) \<longmapsto>w Y(j)" for X Y in bspec)
apply auto
apply (rule PSP_Stable [THEN LeadsTo_weaken], blast, blast)
apply auto
apply (force simp add: part_order_def refl_def)
apply (force simp add: part_order_def refl_def)
apply (drule_tac x = "f1 (x)" and x1 = "f (sa) " and P2 = "%x y. \<forall>u\<in>B. P (x,y,u)" for P in bspec [THEN bspec])
apply (drule_tac [3] x = "g (x) " and x1 = "g (sa) " and P2 = "%x y. P (x,y) \<longrightarrow> d (x,y) \<in> t" for P d in bspec [THEN bspec])
apply auto
apply (rule_tac b = "h (f (sa), g (sa))" and A = C in trans_onD)
apply (auto simp add: part_order_def)
done

lemma imp_LeadsTo_comp_left:
"[| F \<in> Increasing(A, r, f);
  \<forall>j \<in> B. F: {x \<in> state. <j, g(x)> \<in> s} \<longmapsto>w {x \<in> state. <j,g1(x)> \<in> s};
  mono2(A, r, B, s, C, t, h); refl(A,r); refl(B, s); trans[C](t);
  \<forall>x \<in> state. f(x):A & g1(x):B & g(x):B; k \<in> C |] ==>
  F:{x \<in> state. <k, h(f(x), g(x))> \<in> t} \<longmapsto>w {x \<in> state. <k, h(f(x), g1(x))> \<in> t}"
apply (unfold mono2_def Increasing_def)
apply (rule single_LeadsTo_I, auto)
apply (drule_tac x = "f (sa) " and P = "%k. F \<in> Stable (X (k))" for X in bspec)
apply auto
apply (drule_tac x = "g (sa) " in bspec)
apply auto
apply (rule PSP_Stable [THEN LeadsTo_weaken], blast, blast)
apply auto
apply (force simp add: part_order_def refl_def)
apply (force simp add: part_order_def refl_def)
apply (drule_tac x = "f (x) " and x1 = "f (sa) " in bspec [THEN bspec])
apply (drule_tac [3] x = "g1 (x) " and x1 = "g (sa) " and P2 = "%x y. P (x,y) \<longrightarrow> d (x,y) \<in> t" for P d in bspec [THEN bspec])
apply auto
apply (rule_tac b = "h (f (sa), g (sa))" and A = C in trans_onD)
apply (auto simp add: part_order_def)
done

(**  This general result is used to prove Follows Un, munion, etc. **)
lemma imp_LeadsTo_comp2:
"[| F \<in> Increasing(A, r, f1) \<inter>  Increasing(B, s, g);
  \<forall>j \<in> A. F: {s \<in> state. <j, f(s)> \<in> r} \<longmapsto>w {s \<in> state. <j,f1(s)> \<in> r};
  \<forall>j \<in> B. F: {x \<in> state. <j, g(x)> \<in> s} \<longmapsto>w {x \<in> state. <j,g1(x)> \<in> s};
  mono2(A, r, B, s, C, t, h); refl(A,r); refl(B, s); trans[C](t);
  \<forall>x \<in> state. f(x):A & g1(x):B & f1(x):A &g(x):B; k \<in> C |]
  ==> F:{x \<in> state. <k, h(f(x), g(x))> \<in> t} \<longmapsto>w {x \<in> state. <k, h(f1(x), g1(x))> \<in> t}"
apply (rule_tac B = "{x \<in> state. <k, h (f1 (x), g (x))> \<in> t}" in LeadsTo_Trans)
apply (blast intro: imp_LeadsTo_comp_right)
apply (blast intro: imp_LeadsTo_comp_left)
done

(* Follows type *)
lemma Follows_type: "Follows(A, r, f, g)<=program"
apply (unfold Follows_def)
apply (blast dest: Increasing_type [THEN subsetD])
done

lemma Follows_into_program [TC]: "F \<in> Follows(A, r, f, g) ==> F \<in> program"
by (blast dest: Follows_type [THEN subsetD])

lemma FollowsD:
"F \<in> Follows(A, r, f, g)==>
  F \<in> program & (\<exists>a. a \<in> A) & (\<forall>x \<in> state. f(x):A & g(x):A)"
apply (unfold Follows_def)
apply (blast dest: IncreasingD)
done

lemma Follows_constantI:
 "[| F \<in> program; c \<in> A; refl(A, r) |] ==> F \<in> Follows(A, r, %x. c, %x. c)"
apply (unfold Follows_def, auto)
apply (auto simp add: refl_def)
done

lemma subset_Follows_comp:
"[| mono1(A, r, B, s, h); refl(A, r); trans[B](s) |]
   ==> Follows(A, r, f, g) \<subseteq> Follows(B, s,  h comp f, h comp g)"
apply (unfold Follows_def, clarify)
apply (frule_tac f = g in IncreasingD)
apply (frule_tac f = f in IncreasingD)
apply (rule IntI)
apply (rule_tac [2] h = h in imp_LeadsTo_comp)
prefer 5 apply assumption
apply (auto intro: imp_Increasing_comp imp_Always_comp simp del: INT_simps)
done

lemma imp_Follows_comp:
"[| F \<in> Follows(A, r, f, g);  mono1(A, r, B, s, h); refl(A, r); trans[B](s) |]
  ==>  F \<in> Follows(B, s,  h comp f, h comp g)"
apply (blast intro: subset_Follows_comp [THEN subsetD])
done

(* 2-place monotone operation \<in> this general result is used to prove Follows_Un, Follows_munion *)

(* 2-place monotone operation \<in> this general result is
   used to prove Follows_Un, Follows_munion *)
lemma imp_Follows_comp2:
"[| F \<in> Follows(A, r, f1, f);  F \<in> Follows(B, s, g1, g);
   mono2(A, r, B, s, C, t, h); refl(A,r); refl(B, s); trans[C](t) |]
   ==> F \<in> Follows(C, t, %x. h(f1(x), g1(x)), %x. h(f(x), g(x)))"
apply (unfold Follows_def, clarify)
apply (frule_tac f = g in IncreasingD)
apply (frule_tac f = f in IncreasingD)
apply (rule IntI, safe)
apply (rule_tac [3] h = h in imp_Always_comp2)
prefer 5 apply assumption
apply (rule_tac [2] h = h in imp_Increasing_comp2)
prefer 4 apply assumption
apply (rule_tac h = h in imp_Increasing_comp2)
prefer 3 apply assumption
apply simp_all
apply (blast dest!: IncreasingD)
apply (rule_tac h = h in imp_LeadsTo_comp2)
prefer 4 apply assumption
apply auto
  prefer 3 apply (simp add: mono2_def)
apply (blast dest: IncreasingD)+
done

lemma Follows_trans:
     "[| F \<in> Follows(A, r, f, g);  F \<in> Follows(A,r, g, h);
         trans[A](r) |] ==> F \<in> Follows(A, r, f, h)"
apply (frule_tac f = f in FollowsD)
apply (frule_tac f = g in FollowsD)
apply (simp add: Follows_def)
apply (simp add: Always_eq_includes_reachable INT_iff, auto)
apply (rule_tac [2] B = "{s \<in> state. <k, g (s) > \<in> r}" in LeadsTo_Trans)
apply (rule_tac b = "g (x) " in trans_onD)
apply blast+
done

(** Destruction rules for Follows **)

lemma Follows_imp_Increasing_left:
     "F \<in> Follows(A, r, f,g) ==> F \<in> Increasing(A, r, f)"
by (unfold Follows_def, blast)

lemma Follows_imp_Increasing_right:
     "F \<in> Follows(A, r, f,g) ==> F \<in> Increasing(A, r, g)"
by (unfold Follows_def, blast)

lemma Follows_imp_Always:
 "F :Follows(A, r, f, g) ==> F \<in> Always({s \<in> state. <f(s),g(s)> \<in> r})"
by (unfold Follows_def, blast)

lemma Follows_imp_LeadsTo:
 "[| F \<in> Follows(A, r, f, g); k \<in> A |]  ==>
  F: {s \<in> state. <k,g(s)> \<in> r } \<longmapsto>w {s \<in> state. <k,f(s)> \<in> r}"
by (unfold Follows_def, blast)

lemma Follows_LeadsTo_pfixLe:
     "[| F \<in> Follows(list(nat), gen_prefix(nat, Le), f, g); k \<in> list(nat) |]
   ==> F \<in> {s \<in> state. k pfixLe g(s)} \<longmapsto>w {s \<in> state. k pfixLe f(s)}"
by (blast intro: Follows_imp_LeadsTo)

lemma Follows_LeadsTo_pfixGe:
     "[| F \<in> Follows(list(nat), gen_prefix(nat, Ge), f, g); k \<in> list(nat) |]
   ==> F \<in> {s \<in> state. k pfixGe g(s)} \<longmapsto>w {s \<in> state. k pfixGe f(s)}"
by (blast intro: Follows_imp_LeadsTo)

lemma Always_Follows1:
"[| F \<in> Always({s \<in> state. f(s) = g(s)}); F \<in> Follows(A, r, f, h);
    \<forall>x \<in> state. g(x):A |] ==> F \<in> Follows(A, r, g, h)"
apply (unfold Follows_def Increasing_def Stable_def)
apply (simp add: INT_iff, auto)
apply (rule_tac [3] C = "{s \<in> state. f(s)=g(s)}"
        and A = "{s \<in> state. <k, h (s)> \<in> r}"
        and A' = "{s \<in> state. <k, f(s)> \<in> r}" in Always_LeadsTo_weaken)
apply (erule_tac A = "{s \<in> state. <k,f(s) > \<in> r}"
           and A' = "{s \<in> state. <k,f(s) > \<in> r}" in Always_Constrains_weaken)
apply auto
apply (drule Always_Int_I, assumption)
apply (erule_tac A = "{s \<in> state. f(s)=g(s)} \<inter> {s \<in> state. <f(s), h(s)> \<in> r}"
       in Always_weaken)
apply auto
done

lemma Always_Follows2:
"[| F \<in> Always({s \<in> state. g(s) = h(s)});
  F \<in> Follows(A, r, f, g); \<forall>x \<in> state. h(x):A |] ==> F \<in> Follows(A, r, f, h)"
apply (unfold Follows_def Increasing_def Stable_def)
apply (simp add: INT_iff, auto)
apply (rule_tac [3] C = "{s \<in> state. g (s) =h (s) }"
            and A = "{s \<in> state. <k, g (s) > \<in> r}"
            and A' = "{s \<in> state. <k, f (s) > \<in> r}" in Always_LeadsTo_weaken)
apply (erule_tac A = "{s \<in> state. <k, g(s)> \<in> r}"
         and A' = "{s \<in> state. <k, g(s)> \<in> r}" in Always_Constrains_weaken)
apply auto
apply (drule Always_Int_I, assumption)
apply (erule_tac A = "{s \<in> state. g(s)=h(s)} \<inter> {s \<in> state. <f(s), g(s)> \<in> r}"
       in Always_weaken)
apply auto
done

(** Union properties (with the subset ordering) **)

lemma refl_SetLe [simp]: "refl(Pow(A), SetLe(A))"
by (unfold refl_def SetLe_def, auto)

lemma trans_on_SetLe [simp]: "trans[Pow(A)](SetLe(A))"
by (unfold trans_on_def SetLe_def, auto)

lemma antisym_SetLe [simp]: "antisym(SetLe(A))"
by (unfold antisym_def SetLe_def, auto)

lemma part_order_SetLe [simp]: "part_order(Pow(A), SetLe(A))"
by (unfold part_order_def, auto)

lemma increasing_Un:
     "[| F \<in> Increasing.increasing(Pow(A), SetLe(A), f);
         F \<in> Increasing.increasing(Pow(A), SetLe(A), g) |]
     ==> F \<in> Increasing.increasing(Pow(A), SetLe(A), %x. f(x) \<union> g(x))"
by (rule_tac h = "(Un)" in imp_increasing_comp2, auto)

lemma Increasing_Un:
     "[| F \<in> Increasing(Pow(A), SetLe(A), f);
         F \<in> Increasing(Pow(A), SetLe(A), g) |]
     ==> F \<in> Increasing(Pow(A), SetLe(A), %x. f(x) \<union> g(x))"
by (rule_tac h = "(Un)" in imp_Increasing_comp2, auto)

lemma Always_Un:
     "[| F \<in> Always({s \<in> state. f1(s) \<subseteq> f(s)});
     F \<in> Always({s \<in> state. g1(s) \<subseteq> g(s)}) |]
      ==> F \<in> Always({s \<in> state. f1(s) \<union> g1(s) \<subseteq> f(s) \<union> g(s)})"
by (simp add: Always_eq_includes_reachable, blast)

lemma Follows_Un:
"[| F \<in> Follows(Pow(A), SetLe(A), f1, f);
     F \<in> Follows(Pow(A), SetLe(A), g1, g) |]
     ==> F \<in> Follows(Pow(A), SetLe(A), %s. f1(s) \<union> g1(s), %s. f(s) \<union> g(s))"
by (rule_tac h = "(Un)" in imp_Follows_comp2, auto)

(** Multiset union properties (with the MultLe ordering) **)

lemma refl_MultLe [simp]: "refl(Mult(A), MultLe(A,r))"
by (unfold MultLe_def refl_def, auto)

lemma MultLe_refl1 [simp]:
 "[| multiset(M); mset_of(M)<=A |] ==> <M, M> \<in> MultLe(A, r)"
apply (unfold MultLe_def id_def lam_def)
apply (auto simp add: Mult_iff_multiset)
done

lemma MultLe_refl2 [simp]: "M \<in> Mult(A) ==> <M, M> \<in> MultLe(A, r)"
by (unfold MultLe_def id_def lam_def, auto)

lemma trans_on_MultLe [simp]: "trans[Mult(A)](MultLe(A,r))"
apply (unfold MultLe_def trans_on_def)
apply (auto intro: trancl_trans simp add: multirel_def)
done

lemma MultLe_type: "MultLe(A, r)<= (Mult(A) * Mult(A))"
apply (unfold MultLe_def, auto)
apply (drule multirel_type [THEN subsetD], auto)
done

lemma MultLe_trans:
     "[| <M,K> \<in> MultLe(A,r); <K,N> \<in> MultLe(A,r) |] ==> <M,N> \<in> MultLe(A,r)"
apply (cut_tac A=A in trans_on_MultLe)
apply (drule trans_onD, assumption)
apply (auto dest: MultLe_type [THEN subsetD])
done

lemma part_order_imp_part_ord:
     "part_order(A, r) ==> part_ord(A, r-id(A))"
apply (unfold part_order_def part_ord_def)
apply (simp add: refl_def id_def lam_def irrefl_def, auto)
apply (simp (no_asm) add: trans_on_def)
apply auto
apply (blast dest: trans_onD)
apply (simp (no_asm_use) add: antisym_def)
apply auto
done

lemma antisym_MultLe [simp]:
  "part_order(A, r) ==> antisym(MultLe(A,r))"
apply (unfold MultLe_def antisym_def)
apply (drule part_order_imp_part_ord, auto)
apply (drule irrefl_on_multirel)
apply (frule multirel_type [THEN subsetD])
apply (drule multirel_trans)
apply (auto simp add: irrefl_def)
done

lemma part_order_MultLe [simp]:
     "part_order(A, r) ==>  part_order(Mult(A), MultLe(A, r))"
apply (frule antisym_MultLe)
apply (auto simp add: part_order_def)
done

lemma empty_le_MultLe [simp]:
"[| multiset(M); mset_of(M)<= A|] ==> <0, M> \<in> MultLe(A, r)"
apply (unfold MultLe_def)
apply (case_tac "M=0")
apply (auto simp add: FiniteFun.intros)
apply (subgoal_tac "<0 +# 0, 0 +# M> \<in> multirel (A, r - id (A))")
apply (rule_tac [2] one_step_implies_multirel)
apply (auto simp add: Mult_iff_multiset)
done

lemma empty_le_MultLe2 [simp]: "M \<in> Mult(A) ==> <0, M> \<in> MultLe(A, r)"
by (simp add: Mult_iff_multiset)

lemma munion_mono:
"[| <M, N> \<in> MultLe(A, r); <K, L> \<in> MultLe(A, r) |] ==>
  <M +# K, N +# L> \<in> MultLe(A, r)"
apply (unfold MultLe_def)
apply (auto intro: munion_multirel_mono1 munion_multirel_mono2
       munion_multirel_mono multiset_into_Mult simp add: Mult_iff_multiset)
done

lemma increasing_munion:
     "[| F \<in> Increasing.increasing(Mult(A), MultLe(A,r), f);
         F \<in> Increasing.increasing(Mult(A), MultLe(A,r), g) |]
     ==> F \<in> Increasing.increasing(Mult(A),MultLe(A,r), %x. f(x) +# g(x))"
by (rule_tac h = munion in imp_increasing_comp2, auto)

lemma Increasing_munion:
     "[| F \<in> Increasing(Mult(A), MultLe(A,r), f);
         F \<in> Increasing(Mult(A), MultLe(A,r), g)|]
     ==> F \<in> Increasing(Mult(A),MultLe(A,r), %x. f(x) +# g(x))"
by (rule_tac h = munion in imp_Increasing_comp2, auto)

lemma Always_munion:
"[| F \<in> Always({s \<in> state. <f1(s),f(s)> \<in> MultLe(A,r)});
          F \<in> Always({s \<in> state. <g1(s), g(s)> \<in> MultLe(A,r)});
  \<forall>x \<in> state. f1(x):Mult(A)&f(x):Mult(A) & g1(x):Mult(A) & g(x):Mult(A)|]
      ==> F \<in> Always({s \<in> state. <f1(s) +# g1(s), f(s) +# g(s)> \<in> MultLe(A,r)})"
apply (rule_tac h = munion in imp_Always_comp2, simp_all)
apply (blast intro: munion_mono, simp_all)
done

lemma Follows_munion:
"[| F \<in> Follows(Mult(A), MultLe(A, r), f1, f);
    F \<in> Follows(Mult(A), MultLe(A, r), g1, g) |]
  ==> F \<in> Follows(Mult(A), MultLe(A, r), %s. f1(s) +# g1(s), %s. f(s) +# g(s))"
by (rule_tac h = munion in imp_Follows_comp2, auto)

(** Used in ClientImp **)

lemma Follows_msetsum_UN:
"!!f. [| \<forall>i \<in> I. F \<in> Follows(Mult(A), MultLe(A, r), f'(i), f(i));
  \<forall>s. \<forall>i \<in> I. multiset(f'(i, s)) & mset_of(f'(i, s))<=A &
                        multiset(f(i, s)) & mset_of(f(i, s))<=A ;
   Finite(I); F \<in> program |]
        ==> F \<in> Follows(Mult(A),
                        MultLe(A, r), %x. msetsum(%i. f'(i, x), I, A),
                                      %x. msetsum(%i. f(i,  x), I, A))"
apply (erule rev_mp)
apply (drule Finite_into_Fin)
apply (erule Fin_induct)
apply (simp (no_asm_simp))
apply (rule Follows_constantI)
apply (simp_all (no_asm_simp) add: FiniteFun.intros)
apply auto
apply (rule Follows_munion, auto)
done

end


\<^marker>\<open>creator "Alexander Krauss"\<close>
\<^marker>\<open>creator "Josh Chen"\<close>
\<^marker>\<open>creator "Kevin Kappelmann"\<close>
section \<open>Monoids\<close>
theory Monoids
  imports Structures
begin
text \<open>An experiment with softly-typed, set-theoretic type classes.

We define monoids as a soft type class and experiment with how it interacts
with implicit arguments and type inference. Everything is done manually here;
most of it will be automated away in future work.\<close>

text \<open>The monoid typeclass is defined using the standard soft type
infrastructure.\<close>

definition [typeclass]: "Monoid A \<equiv> Zero A & Add A &
  type (\<lambda>M.
    (\<forall>x : A. add M (zero M) x = x \<and> add M x (zero M) = x) \<and>
    (\<forall>x y z : A. add M (add M x y) z = add M x (add M y z)))"

text \<open>It would be really nice if this worked:\<close>

(* declare [[auto_elaborate]]
lemma MonoidI:
  assumes "M : Zero A" "M : Add A"
  and "\<And>x. x : A \<Longrightarrow> 0 + x = x"
  and "\<And>x. x : A \<Longrightarrow> x + 0 = x"
  and "\<And>x y z. \<lbrakk>x : A; y : A; z : A\<rbrakk> \<Longrightarrow> x + y + z = x + (y + z)"
  shows "M : Monoid A"
  unfolding Monoid_def
  apply unfold_types
  apply auto \<comment>\<open>Doesn't use the assumptions as they weren't elaborated correctly\<close>
  using assms
oops
declare [[auto_elaborate=false]] *)

text \<open>Instead we have to do this for now:\<close>

lemma MonoidI:
  assumes "M : Zero A" "M : Add A"
  and "\<And>x. x : A \<Longrightarrow> add M (zero M) x = x"
  and "\<And>x. x : A \<Longrightarrow> add M x (zero M) = x"
  and "\<And>x y z. \<lbrakk>x : A; y : A; z : A\<rbrakk> \<Longrightarrow>
    add M (add M x y) z = add M x (add M y z)"
  shows "M : Monoid A"
  unfolding Monoid_def
  by (intro Int_typeI has_typeI) (auto intro: assms)

text \<open>The above theorem as well as the next ones should also be automatically
generated.\<close>

lemma
  shows Monoid_Zero [derive]: "M : Monoid A \<Longrightarrow> M : Zero A"
  and Monoid_Add [derive]: "M : Monoid A \<Longrightarrow> M : Add A"
  and Monoid_zero_add_eq [simp]:
    "\<And>x. M : Monoid A \<Longrightarrow> x : A \<Longrightarrow> add M (zero M) x = x"
  and Monoid_add_zero_eq [simp]:
    "\<And>x. M : Monoid A \<Longrightarrow> x : A \<Longrightarrow> add M x (zero M) = x"
  and Monoid_add_assoc:
    "\<And>x y z. \<lbrakk>M : Monoid A; x : A; y : A; z : A\<rbrakk> \<Longrightarrow>
      add M (add M x y) z = add M x (add M y z)"
  (* TODO: should be provable by type checker *)
  unfolding Monoid_def by (auto 7 0 dest!: Int_typeD1 Int_typeD2 has_typeD)

subsection \<open>Direct sum\<close>

text \<open>We develop the construction of direct sums of monoids by defining it as
the (disjoint) union of the zero and add structures.

We emulate automation that needs to be implemented in future work.\<close>

definition "Zero_pair Z1 Z2 \<equiv> object {\<langle>@zero, \<langle>zero Z1, zero Z2\<rangle>\<rangle>}"

(*TODO: These should be automatically generated*)
lemma Zero_pair_fields_eq [simp]: "object_fields (Zero_pair Z1 Z2) = {@zero}"
  unfolding Zero_pair_def by simp

lemma Zero_pair_zero_eq [simp]: "(Zero_pair Z1 Z2) @@ zero = \<langle>zero Z1, zero Z2\<rangle>"
  unfolding Zero_pair_def by simp

lemma Zero_pair_type [type]: "Zero_pair: Zero A \<Rightarrow> Zero B \<Rightarrow> Zero (A \<times> B)"
  by (intro Dep_fun_typeI, rule ZeroI) auto

definition "Add_pair A B AA AB \<equiv> object {
    \<langle>@add, \<lambda>\<langle>a1, b1\<rangle> \<langle>a2, b2\<rangle> \<in> A \<times> B. \<langle>add AA a1 a2, add AB b1 b2\<rangle>\<rangle>
  }"

(*TODO: These should be automatically generated*)
lemma Add_pair_fields_eq [simp]: "object_fields (Add_pair A B AA AB) = {@add}"
  unfolding Add_pair_def by simp

lemma Add_pair_add_eq [simp]:
  "(Add_pair A B AA AB) @@ add =
    \<lambda>\<langle>a1, b1\<rangle> \<langle>a2, b2\<rangle> \<in> A \<times> B. \<langle>add AA a1 a2, add AB b1 b2\<rangle>"
  unfolding Add_pair_def by simp

(* TODO: quite challenging for automatic type derivation *)
lemma Add_pair_type [type]:
  "Add_pair: (A : Set) \<Rightarrow> (B : Set) \<Rightarrow> Add (Element A) \<Rightarrow> Add (Element B)
    \<Rightarrow> Add (Element (A \<times> B))"
proof (intro Dep_fun_typeI AddI, subst Add_pair_add_eq)
  fix A B AA AB assume h: "AA : Add (Element A)" "AB : Add (Element B)"
  let ?f = "\<lambda>\<langle>a1, b1\<rangle> \<in> A \<times> B. \<lambda>\<langle>a2, b2\<rangle> \<in> A \<times> B. \<langle>add AA a1 a2, add AB b1 b2\<rangle>"
  from h have "?f : Element (A \<times> B) \<rightarrow>cs Element (A \<times> B) \<rightarrow>cs Element (A \<times> B)"
    by (auto iff: Element_dep_pairs_iff_Dep_Pair
      intro!: lambda_app_type Dep_fun_typeI, discharge_types)
  then show "?f : Element (A \<times> B) \<rightarrow>s (Element (A \<times> B) \<rightarrow>s Element (A \<times> B))"
    using Dep_Function_covariant_codom by auto
qed

text \<open>TODO: In the future, there should be a command for object
composition/extension.\<close>

definition "Monoid_pair A B MA MB \<equiv> object {
    \<langle>@zero, \<langle>zero MA, zero MB\<rangle>\<rangle>,
    \<langle>@add, \<lambda>\<langle>a1, b1\<rangle> \<langle>a2, b2\<rangle> \<in> A \<times> B. \<langle>add MA a1 a2, add MB b1 b2\<rangle>\<rangle>
  }"

lemma Monoid_pair_fields_eq [simp]:
  "object_fields (Monoid_pair A B MA MB) = {@zero, @add}"
  unfolding Monoid_pair_def by simp

text \<open>The following proofs illustrate that reasoning with types is still very
pedestrian and needs better automated support.\<close>

lemma Monoid_pair_type [type]:
  "Monoid_pair : (A : Set) \<Rightarrow> (B : Set) \<Rightarrow> Monoid (Element A) \<Rightarrow>
    Monoid (Element B) \<Rightarrow> Monoid (Element (A \<times> B))"
proof (intro Dep_fun_typeI MonoidI)
  fix A B MA MB assume "MA : Monoid (Element A)" "MB : Monoid (Element B)"
  let ?M = "Monoid_pair A B MA MB"
  show "?M : Zero (Element (A \<times> B))"
    by (rule ZeroI) (auto iff: Element_dep_pairs_iff_Dep_Pair)
  have 1: "\<And>p. p : Element (A \<times> B) \<longleftrightarrow> p : Element A \<times> Element B"
    by unfold_types auto
  have "\<lambda>\<langle>a1, b1\<rangle> \<langle>a2, b2\<rangle> \<in> A \<times> B. \<langle>add MA a1 a2, add MB b1 b2\<rangle>
    : Element (A \<times> B) \<rightarrow>cs Element (A \<times> B) \<rightarrow>cs Element (A \<times> B)"
    using [[type_derivation_depth=8]]
    apply (rule lambda_app_type)
    apply (rule Dep_fun_contravariant_dom[where ?A="Element A \<times> Element B"])
    apply (rule uncurry_app_type)
    apply (intro Dep_fun_typeI)
    apply (rule lambda_app_type)
    apply (rule Dep_fun_contravariant_dom[where ?A="Element A \<times> Element B"])
    apply (rule uncurry_app_type)
    apply (intro Dep_fun_typeI)
    apply (simp_all only: 1)
    done
  then have "\<lambda>\<langle>a1, b1\<rangle> \<langle>a2, b2\<rangle> \<in> A \<times> B. \<langle>add MA a1 a2, add MB b1 b2\<rangle>
    : Element (A \<times> B) \<rightarrow>s Element (A \<times> B) \<rightarrow>s Element (A \<times> B)"
    by (auto intro: Dep_Function_if_CDep_Function CDep_Function_covariant_codom)
  show "?M : Add (Element (A \<times> B))"
    (*TODO: this should also work*)
    (* by (rule AddI) simp*)
    by (rule AddI, subst Monoid_pair_add_eq) fact

  fix x assume "x : Element (A \<times> B)"
  then show "add ?M (zero ?M) x = x" and "add ?M x (zero ?M) = x"
    unfolding add_def zero_def by (auto iff: 1)

  fix y z assume "y : Element (A \<times> B)" "z : Element (A \<times> B)"
  then show "add ?M (add ?M x y) z = add ?M x (add ?M y z)"
    unfolding add_def using \<open>x : Element (A \<times> B)\<close> Monoid_add_assoc
oops

lemma [type_instance]:
  "MA : Zero A \<Longrightarrow> MB : Zero B \<Longrightarrow> Zero_pair MA MB : Zero (A \<times> B)"
  by discharge_types

lemma [type_instance]:
  "MA : Add (Element A) \<Longrightarrow> MB : Add (Element B) \<Longrightarrow>
    Add_pair A B MA MB : Add (Element (A \<times> B))"
  by discharge_types

lemma [type_instance]:
  "MA : Monoid (Element A) \<Longrightarrow> MB : Monoid (Element B) \<Longrightarrow>
    Monoid_pair A B MA MB : Monoid (Element (A \<times> B))"
oops

(* subsection \<open>Overloaded syntax\<close>

context
  notes [[auto_elaborate, trace_soft_types]]
begin

lemma "x + 0 = x"
  print_types
  oops

lemma "\<langle>x, y\<rangle> + 0 = \<langle>x, y\<rangle>"
  print_types
  oops

lemma "x + (y + z) = x + y + z"
  print_types
  oops

lemma "x + y = z + w \<and> u + v = 0"
  print_types
  oops

end *)

subsection \<open>Extension to groups\<close>

definition [typeclass]: "Group A \<equiv> Monoid A & Inv A &
  type (\<lambda>G.
    (\<forall>x : A. add G x (inv G x) = zero G) \<and>
    (\<forall>x : A. add G (inv G x) x = zero G))"

lemma GroupI [type_intro]:
  assumes "G : Monoid A" "G : Inv A"
  and "\<And>x. x : A \<Longrightarrow> add G x (inv G x) = zero G"
  and "\<And>x. x : A \<Longrightarrow> add G (inv G x) x = zero G"
  shows "G : Group A"
  unfolding Group_def
  by (intro Int_typeI has_typeI) (auto intro: assms)

lemma Group_Monoid [derive]:  "G : Group A \<Longrightarrow> G : Monoid A"
  unfolding Group_def by (drule Int_typeD1)+

definition [typeclass]: "Comm_Group A \<equiv> Group A &
  type (\<lambda>G. \<forall>a b : A. add G a b = add G b a)"

lemma Comm_GroupI [type_intro]:
  assumes "G : Group A"
  and "\<And>x y. x : A \<Longrightarrow> y : A \<Longrightarrow> add G x y = add G y x"
  shows "G : Comm_Group A"
  unfolding Comm_Group_def
  by (intro Int_typeI has_typeI) (auto intro: assms)

lemma shows Comm_Group_Group [derive]: "G : Comm_Group A \<Longrightarrow> G : Group A"
  unfolding Comm_Group_def by (drule Int_typeD1)

lemma shows Comm_Group_add_comm:
  "\<And>x y. \<lbrakk>G : Comm_Group A; x : A; y : A\<rbrakk> \<Longrightarrow> add G x y = add G y x"
  unfolding Comm_Group_def by (auto dest: Int_typeD2 has_typeD)

subsection \<open>Multiplicative monoids\<close>

text \<open>This is just a copy of the additive monoid structure above and should be
automatically generated in the future, or be put in a unified framework.\<close>

definition [typeclass]: "Mul_Monoid A \<equiv> One A & Mul A &
  type (\<lambda>M.
    (\<forall>x : A. mul M (one M) x = x \<and> mul M x (one M) = x) \<and>
    (\<forall>x y z : A. mul M (mul M x y) z = mul M x (mul M y z)))"

lemma Mul_MonoidI:
  assumes "M : One A" "M : Mul A"
  and "\<And>x. x : A \<Longrightarrow> mul M (one M) x = x"
  and "\<And>x. x : A \<Longrightarrow> mul M x (one M) = x"
  and "\<And>x y z. \<lbrakk>x : A; y : A; z : A\<rbrakk> \<Longrightarrow>
    mul M (mul M x y) z = mul M x (mul M y z)"
  shows "M : Mul_Monoid A"
  unfolding Mul_Monoid_def by (intro Int_typeI has_typeI) (auto intro: assms)

lemma
  shows Mul_Monoid_One [derive]: "M : Mul_Monoid A \<Longrightarrow> M : One A"
  and Mul_Monoid_Mul [derive]: "M : Mul_Monoid A \<Longrightarrow> M : Mul A"
  and Mul_Monoid_one_mul_eq [simp]:
    "\<And>x. M : Mul_Monoid A \<Longrightarrow> x : A \<Longrightarrow> mul M (one M) x = x"
  and Mul_Monoid_mul_one_eq [simp]:
    "\<And>x. M : Mul_Monoid A \<Longrightarrow> x : A \<Longrightarrow> mul M x (one M) = x"
  and Mul_Monoid_mul_assoc:
    "\<And>x y z. \<lbrakk>M : Mul_Monoid A; x : A; y : A; z : A\<rbrakk> \<Longrightarrow>
      mul M (mul M x y) z = mul M x (mul M y z)"
  (* TODO: should be provable by type checker *)
  unfolding Mul_Monoid_def by (auto 7 0 dest!: Int_typeD1 Int_typeD2 has_typeD)

end


(*  Title:      FOL/ex/Intro.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1992  University of Cambridge

Derives some inference rules, illustrating the use of definitions.
*)

section \<open>Examples for the manual ``Introduction to Isabelle''\<close>

theory Intro
imports FOL
begin

subsubsection \<open>Some simple backward proofs\<close>

lemma mythm: "P \<or> P \<longrightarrow> P"
apply (rule impI)
apply (rule disjE)
prefer 3 apply (assumption)
prefer 2 apply (assumption)
apply assumption
done

lemma "(P \<and> Q) \<or> R \<longrightarrow> (P \<or> R)"
apply (rule impI)
apply (erule disjE)
apply (drule conjunct1)
apply (rule disjI1)
apply (rule_tac [2] disjI2)
apply assumption+
done

text \<open>Correct version, delaying use of \<open>spec\<close> until last.\<close>
lemma "(\<forall>x y. P(x,y)) \<longrightarrow> (\<forall>z w. P(w,z))"
apply (rule impI)
apply (rule allI)
apply (rule allI)
apply (drule spec)
apply (drule spec)
apply assumption
done

subsubsection \<open>Demonstration of \<open>fast\<close>\<close>

lemma "(\<exists>y. \<forall>x. J(y,x) \<longleftrightarrow> \<not> J(x,x)) \<longrightarrow> \<not> (\<forall>x. \<exists>y. \<forall>z. J(z,y) \<longleftrightarrow> \<not> J(z,x))"
apply fast
done

lemma "\<forall>x. P(x,f(x)) \<longleftrightarrow> (\<exists>y. (\<forall>z. P(z,y) \<longrightarrow> P(z,f(x))) \<and> P(x,y))"
apply fast
done

subsubsection \<open>Derivation of conjunction elimination rule\<close>

lemma
  assumes major: "P \<and> Q"
    and minor: "\<lbrakk>P; Q\<rbrakk> \<Longrightarrow> R"
  shows R
apply (rule minor)
apply (rule major [THEN conjunct1])
apply (rule major [THEN conjunct2])
done

subsection \<open>Derived rules involving definitions\<close>

text \<open>Derivation of negation introduction\<close>

lemma
  assumes "P \<Longrightarrow> False"
  shows "\<not> P"
apply (unfold not_def)
apply (rule impI)
apply (rule assms)
apply assumption
done

lemma
  assumes major: "\<not> P"
    and minor: P
  shows R
apply (rule FalseE)
apply (rule mp)
apply (rule major [unfolded not_def])
apply (rule minor)
done

text \<open>Alternative proof of the result above\<close>
lemma
  assumes major: "\<not> P"
    and minor: P
  shows R
apply (rule minor [THEN major [unfolded not_def, THEN mp, THEN FalseE]])
done

end