(*  Title:      ZF/Constructible/L_axioms.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
*)

section \<open>The ZF Axioms (Except Separation) in L\<close>

theory L_axioms imports Formula Relative Reflection MetaExists begin

text \<open>The class L satisfies the premises of locale \<open>M_trivial\<close>\<close>

lemma transL: "[| y\<in>x; L(x) |] ==> L(y)"
apply (insert Transset_Lset)
apply (simp add: Transset_def L_def, blast)
done

lemma nonempty: "L(0)"
apply (simp add: L_def)
apply (blast intro: zero_in_Lset)
done

theorem upair_ax: "upair_ax(L)"
apply (simp add: upair_ax_def upair_def, clarify)
apply (rule_tac x="{x,y}" in rexI)
apply (simp_all add: doubleton_in_L)
done

theorem Union_ax: "Union_ax(L)"
apply (simp add: Union_ax_def big_union_def, clarify)
apply (rule_tac x="\<Union>(x)" in rexI)
apply (simp_all add: Union_in_L, auto)
apply (blast intro: transL)
done

theorem power_ax: "power_ax(L)"
apply (simp add: power_ax_def powerset_def Relative.subset_def, clarify)
apply (rule_tac x="{y \<in> Pow(x). L(y)}" in rexI)
apply (simp_all add: LPow_in_L, auto)
apply (blast intro: transL)
done

text\<open>We don't actually need \<^term>\<open>L\<close> to satisfy the foundation axiom.\<close>
theorem foundation_ax: "foundation_ax(L)"
apply (simp add: foundation_ax_def)
apply (rule rallI)
apply (cut_tac A=x in foundation)
apply (blast intro: transL)
done

subsection\<open>For L to satisfy Replacement\<close>

(*Can't move these to Formula unless the definition of univalent is moved
there too!*)

lemma LReplace_in_Lset:
     "[|X \<in> Lset(i); univalent(L,X,Q); Ord(i)|]
      ==> \<exists>j. Ord(j) & Replace(X, %x y. Q(x,y) & L(y)) \<subseteq> Lset(j)"
apply (rule_tac x="\<Union>y \<in> Replace(X, %x y. Q(x,y) & L(y)). succ(lrank(y))"
       in exI)
apply simp
apply clarify
apply (rule_tac a=x in UN_I)
 apply (simp_all add: Replace_iff univalent_def)
apply (blast dest: transL L_I)
done

lemma LReplace_in_L:
     "[|L(X); univalent(L,X,Q)|]
      ==> \<exists>Y. L(Y) & Replace(X, %x y. Q(x,y) & L(y)) \<subseteq> Y"
apply (drule L_D, clarify)
apply (drule LReplace_in_Lset, assumption+)
apply (blast intro: L_I Lset_in_Lset_succ)
done

theorem replacement: "replacement(L,P)"
apply (simp add: replacement_def, clarify)
apply (frule LReplace_in_L, assumption+, clarify)
apply (rule_tac x=Y in rexI)
apply (simp_all add: Replace_iff univalent_def, blast)
done

lemma strong_replacementI [rule_format]:
    "[| \<forall>B[L]. separation(L, %u. \<exists>x[L]. x\<in>B & P(x,u)) |]
     ==> strong_replacement(L,P)"
apply (simp add: strong_replacement_def, clarify)
apply (frule replacementD [OF replacement], assumption, clarify)
apply (drule_tac x=A in rspec, clarify)
apply (drule_tac z=Y in separationD, assumption, clarify)
apply (rule_tac x=y in rexI, force, assumption)
done

subsection\<open>Instantiating the locale \<open>M_trivial\<close>\<close>
text\<open>No instances of Separation yet.\<close>

lemma Lset_mono_le: "mono_le_subset(Lset)"
by (simp add: mono_le_subset_def le_imp_subset Lset_mono)

lemma Lset_cont: "cont_Ord(Lset)"
by (simp add: cont_Ord_def Limit_Lset_eq OUnion_def Limit_is_Ord)

lemmas L_nat = Ord_in_L [OF Ord_nat]

theorem M_trivial_L: "M_trivial(L)"
  apply (rule M_trivial.intro)
  apply (rule M_trans.intro)
    apply (erule (1) transL)
   apply(rule exI,rule  nonempty)
  apply (rule M_trivial_axioms.intro)
      apply (rule upair_ax)
   apply (rule Union_ax)
  done

interpretation L: M_trivial L by (rule M_trivial_L)

(* Replaces the following declarations...
lemmas rall_abs = M_trivial.rall_abs [OF M_trivial_L]
  and rex_abs = M_trivial.rex_abs [OF M_trivial_L]
...
declare rall_abs [simp]
declare rex_abs [simp]
...and dozens of similar ones.
*)

subsection\<open>Instantiation of the locale \<open>reflection\<close>\<close>

text\<open>instances of locale constants\<close>

definition
  L_F0 :: "[i=>o,i] => i" where
    "L_F0(P,y) == \<mu> b. (\<exists>z. L(z) \<and> P(<y,z>)) \<longrightarrow> (\<exists>z\<in>Lset(b). P(<y,z>))"

definition
  L_FF :: "[i=>o,i] => i" where
    "L_FF(P)   == \<lambda>a. \<Union>y\<in>Lset(a). L_F0(P,y)"

definition
  L_ClEx :: "[i=>o,i] => o" where
    "L_ClEx(P) == \<lambda>a. Limit(a) \<and> normalize(L_FF(P),a) = a"

text\<open>We must use the meta-existential quantifier; otherwise the reflection
      terms become enormous!\<close>
definition
  L_Reflects :: "[i=>o,[i,i]=>o] => prop"  (\<open>(3REFLECTS/ [_,/ _])\<close>) where
    "REFLECTS[P,Q] == (\<Or>Cl. Closed_Unbounded(Cl) &
                           (\<forall>a. Cl(a) \<longrightarrow> (\<forall>x \<in> Lset(a). P(x) \<longleftrightarrow> Q(a,x))))"

theorem Triv_reflection:
     "REFLECTS[P, \<lambda>a x. P(x)]"
apply (simp add: L_Reflects_def)
apply (rule meta_exI)
apply (rule Closed_Unbounded_Ord)
done

theorem Not_reflection:
     "REFLECTS[P,Q] ==> REFLECTS[\<lambda>x. ~P(x), \<lambda>a x. ~Q(a,x)]"
apply (unfold L_Reflects_def)
apply (erule meta_exE)
apply (rule_tac x=Cl in meta_exI, simp)
done

theorem And_reflection:
     "[| REFLECTS[P,Q]; REFLECTS[P',Q'] |]
      ==> REFLECTS[\<lambda>x. P(x) \<and> P'(x), \<lambda>a x. Q(a,x) \<and> Q'(a,x)]"
apply (unfold L_Reflects_def)
apply (elim meta_exE)
apply (rule_tac x="\<lambda>a. Cl(a) \<and> Cla(a)" in meta_exI)
apply (simp add: Closed_Unbounded_Int, blast)
done

theorem Or_reflection:
     "[| REFLECTS[P,Q]; REFLECTS[P',Q'] |]
      ==> REFLECTS[\<lambda>x. P(x) \<or> P'(x), \<lambda>a x. Q(a,x) \<or> Q'(a,x)]"
apply (unfold L_Reflects_def)
apply (elim meta_exE)
apply (rule_tac x="\<lambda>a. Cl(a) \<and> Cla(a)" in meta_exI)
apply (simp add: Closed_Unbounded_Int, blast)
done

theorem Imp_reflection:
     "[| REFLECTS[P,Q]; REFLECTS[P',Q'] |]
      ==> REFLECTS[\<lambda>x. P(x) \<longrightarrow> P'(x), \<lambda>a x. Q(a,x) \<longrightarrow> Q'(a,x)]"
apply (unfold L_Reflects_def)
apply (elim meta_exE)
apply (rule_tac x="\<lambda>a. Cl(a) \<and> Cla(a)" in meta_exI)
apply (simp add: Closed_Unbounded_Int, blast)
done

theorem Iff_reflection:
     "[| REFLECTS[P,Q]; REFLECTS[P',Q'] |]
      ==> REFLECTS[\<lambda>x. P(x) \<longleftrightarrow> P'(x), \<lambda>a x. Q(a,x) \<longleftrightarrow> Q'(a,x)]"
apply (unfold L_Reflects_def)
apply (elim meta_exE)
apply (rule_tac x="\<lambda>a. Cl(a) \<and> Cla(a)" in meta_exI)
apply (simp add: Closed_Unbounded_Int, blast)
done

lemma reflection_Lset: "reflection(Lset)"
by (blast intro: reflection.intro Lset_mono_le Lset_cont
                 Formula.Pair_in_LLimit)+

theorem Ex_reflection:
     "REFLECTS[\<lambda>x. P(fst(x),snd(x)), \<lambda>a x. Q(a,fst(x),snd(x))]
      ==> REFLECTS[\<lambda>x. \<exists>z. L(z) \<and> P(x,z), \<lambda>a x. \<exists>z\<in>Lset(a). Q(a,x,z)]"
apply (unfold L_Reflects_def L_ClEx_def L_FF_def L_F0_def L_def)
apply (elim meta_exE)
apply (rule meta_exI)
apply (erule reflection.Ex_reflection [OF reflection_Lset])
done

theorem All_reflection:
     "REFLECTS[\<lambda>x. P(fst(x),snd(x)), \<lambda>a x. Q(a,fst(x),snd(x))]
      ==> REFLECTS[\<lambda>x. \<forall>z. L(z) \<longrightarrow> P(x,z), \<lambda>a x. \<forall>z\<in>Lset(a). Q(a,x,z)]"
apply (unfold L_Reflects_def L_ClEx_def L_FF_def L_F0_def L_def)
apply (elim meta_exE)
apply (rule meta_exI)
apply (erule reflection.All_reflection [OF reflection_Lset])
done

theorem Rex_reflection:
     "REFLECTS[ \<lambda>x. P(fst(x),snd(x)), \<lambda>a x. Q(a,fst(x),snd(x))]
      ==> REFLECTS[\<lambda>x. \<exists>z[L]. P(x,z), \<lambda>a x. \<exists>z\<in>Lset(a). Q(a,x,z)]"
apply (unfold rex_def)
apply (intro And_reflection Ex_reflection, assumption)
done

theorem Rall_reflection:
     "REFLECTS[\<lambda>x. P(fst(x),snd(x)), \<lambda>a x. Q(a,fst(x),snd(x))]
      ==> REFLECTS[\<lambda>x. \<forall>z[L]. P(x,z), \<lambda>a x. \<forall>z\<in>Lset(a). Q(a,x,z)]"
apply (unfold rall_def)
apply (intro Imp_reflection All_reflection, assumption)
done

text\<open>This version handles an alternative form of the bounded quantifier
      in the second argument of \<open>REFLECTS\<close>.\<close>
theorem Rex_reflection':
     "REFLECTS[\<lambda>x. P(fst(x),snd(x)), \<lambda>a x. Q(a,fst(x),snd(x))]
      ==> REFLECTS[\<lambda>x. \<exists>z[L]. P(x,z), \<lambda>a x. \<exists>z[##Lset(a)]. Q(a,x,z)]"
apply (unfold setclass_def rex_def)
apply (erule Rex_reflection [unfolded rex_def Bex_def])
done

text\<open>As above.\<close>
theorem Rall_reflection':
     "REFLECTS[\<lambda>x. P(fst(x),snd(x)), \<lambda>a x. Q(a,fst(x),snd(x))]
      ==> REFLECTS[\<lambda>x. \<forall>z[L]. P(x,z), \<lambda>a x. \<forall>z[##Lset(a)]. Q(a,x,z)]"
apply (unfold setclass_def rall_def)
apply (erule Rall_reflection [unfolded rall_def Ball_def])
done

lemmas FOL_reflections =
        Triv_reflection Not_reflection And_reflection Or_reflection
        Imp_reflection Iff_reflection Ex_reflection All_reflection
        Rex_reflection Rall_reflection Rex_reflection' Rall_reflection'

lemma ReflectsD:
     "[|REFLECTS[P,Q]; Ord(i)|]
      ==> \<exists>j. i<j & (\<forall>x \<in> Lset(j). P(x) \<longleftrightarrow> Q(j,x))"
apply (unfold L_Reflects_def Closed_Unbounded_def)
apply (elim meta_exE, clarify)
apply (blast dest!: UnboundedD)
done

lemma ReflectsE:
     "[| REFLECTS[P,Q]; Ord(i);
         !!j. [|i<j;  \<forall>x \<in> Lset(j). P(x) \<longleftrightarrow> Q(j,x)|] ==> R |]
      ==> R"
by (drule ReflectsD, assumption, blast)

lemma Collect_mem_eq: "{x\<in>A. x\<in>B} = A \<inter> B"
by blast

subsection\<open>Internalized Formulas for some Set-Theoretic Concepts\<close>

subsubsection\<open>Some numbers to help write de Bruijn indices\<close>

abbreviation
  digit3 :: i   (\<open>3\<close>) where "3 == succ(2)"

abbreviation
  digit4 :: i   (\<open>4\<close>) where "4 == succ(3)"

abbreviation
  digit5 :: i   (\<open>5\<close>) where "5 == succ(4)"

abbreviation
  digit6 :: i   (\<open>6\<close>) where "6 == succ(5)"

abbreviation
  digit7 :: i   (\<open>7\<close>) where "7 == succ(6)"

abbreviation
  digit8 :: i   (\<open>8\<close>) where "8 == succ(7)"

abbreviation
  digit9 :: i   (\<open>9\<close>) where "9 == succ(8)"

subsubsection\<open>The Empty Set, Internalized\<close>

definition
  empty_fm :: "i=>i" where
    "empty_fm(x) == Forall(Neg(Member(0,succ(x))))"

lemma empty_type [TC]:
     "x \<in> nat ==> empty_fm(x) \<in> formula"
by (simp add: empty_fm_def)

lemma sats_empty_fm [simp]:
   "[| x \<in> nat; env \<in> list(A)|]
    ==> sats(A, empty_fm(x), env) \<longleftrightarrow> empty(##A, nth(x,env))"
by (simp add: empty_fm_def empty_def)

lemma empty_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; env \<in> list(A)|]
       ==> empty(##A, x) \<longleftrightarrow> sats(A, empty_fm(i), env)"
by simp

theorem empty_reflection:
     "REFLECTS[\<lambda>x. empty(L,f(x)),
               \<lambda>i x. empty(##Lset(i),f(x))]"
apply (simp only: empty_def)
apply (intro FOL_reflections)
done

text\<open>Not used.  But maybe useful?\<close>
lemma Transset_sats_empty_fm_eq_0:
   "[| n \<in> nat; env \<in> list(A); Transset(A)|]
    ==> sats(A, empty_fm(n), env) \<longleftrightarrow> nth(n,env) = 0"
apply (simp add: empty_fm_def empty_def Transset_def, auto)
apply (case_tac "n < length(env)")
apply (frule nth_type, assumption+, blast)
apply (simp_all add: not_lt_iff_le nth_eq_0)
done

subsubsection\<open>Unordered Pairs, Internalized\<close>

definition
  upair_fm :: "[i,i,i]=>i" where
    "upair_fm(x,y,z) ==
       And(Member(x,z),
           And(Member(y,z),
               Forall(Implies(Member(0,succ(z)),
                              Or(Equal(0,succ(x)), Equal(0,succ(y)))))))"

lemma upair_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> upair_fm(x,y,z) \<in> formula"
by (simp add: upair_fm_def)

lemma sats_upair_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, upair_fm(x,y,z), env) \<longleftrightarrow>
            upair(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: upair_fm_def upair_def)

lemma upair_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> upair(##A, x, y, z) \<longleftrightarrow> sats(A, upair_fm(i,j,k), env)"
by (simp)

text\<open>Useful? At least it refers to "real" unordered pairs\<close>
lemma sats_upair_fm2 [simp]:
   "[| x \<in> nat; y \<in> nat; z < length(env); env \<in> list(A); Transset(A)|]
    ==> sats(A, upair_fm(x,y,z), env) \<longleftrightarrow>
        nth(z,env) = {nth(x,env), nth(y,env)}"
apply (frule lt_length_in_nat, assumption)
apply (simp add: upair_fm_def Transset_def, auto)
apply (blast intro: nth_type)
done

theorem upair_reflection:
     "REFLECTS[\<lambda>x. upair(L,f(x),g(x),h(x)),
               \<lambda>i x. upair(##Lset(i),f(x),g(x),h(x))]"
apply (simp add: upair_def)
apply (intro FOL_reflections)
done

subsubsection\<open>Ordered pairs, Internalized\<close>

definition
  pair_fm :: "[i,i,i]=>i" where
    "pair_fm(x,y,z) ==
       Exists(And(upair_fm(succ(x),succ(x),0),
              Exists(And(upair_fm(succ(succ(x)),succ(succ(y)),0),
                         upair_fm(1,0,succ(succ(z)))))))"

lemma pair_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> pair_fm(x,y,z) \<in> formula"
by (simp add: pair_fm_def)

lemma sats_pair_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, pair_fm(x,y,z), env) \<longleftrightarrow>
        pair(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: pair_fm_def pair_def)

lemma pair_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> pair(##A, x, y, z) \<longleftrightarrow> sats(A, pair_fm(i,j,k), env)"
by (simp)

theorem pair_reflection:
     "REFLECTS[\<lambda>x. pair(L,f(x),g(x),h(x)),
               \<lambda>i x. pair(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: pair_def)
apply (intro FOL_reflections upair_reflection)
done

subsubsection\<open>Binary Unions, Internalized\<close>

definition
  union_fm :: "[i,i,i]=>i" where
    "union_fm(x,y,z) ==
       Forall(Iff(Member(0,succ(z)),
                  Or(Member(0,succ(x)),Member(0,succ(y)))))"

lemma union_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> union_fm(x,y,z) \<in> formula"
by (simp add: union_fm_def)

lemma sats_union_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, union_fm(x,y,z), env) \<longleftrightarrow>
        union(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: union_fm_def union_def)

lemma union_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> union(##A, x, y, z) \<longleftrightarrow> sats(A, union_fm(i,j,k), env)"
by (simp)

theorem union_reflection:
     "REFLECTS[\<lambda>x. union(L,f(x),g(x),h(x)),
               \<lambda>i x. union(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: union_def)
apply (intro FOL_reflections)
done

subsubsection\<open>Set ``Cons,'' Internalized\<close>

definition
  cons_fm :: "[i,i,i]=>i" where
    "cons_fm(x,y,z) ==
       Exists(And(upair_fm(succ(x),succ(x),0),
                  union_fm(0,succ(y),succ(z))))"

lemma cons_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> cons_fm(x,y,z) \<in> formula"
by (simp add: cons_fm_def)

lemma sats_cons_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, cons_fm(x,y,z), env) \<longleftrightarrow>
        is_cons(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: cons_fm_def is_cons_def)

lemma cons_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> is_cons(##A, x, y, z) \<longleftrightarrow> sats(A, cons_fm(i,j,k), env)"
by simp

theorem cons_reflection:
     "REFLECTS[\<lambda>x. is_cons(L,f(x),g(x),h(x)),
               \<lambda>i x. is_cons(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: is_cons_def)
apply (intro FOL_reflections upair_reflection union_reflection)
done

subsubsection\<open>Successor Function, Internalized\<close>

definition
  succ_fm :: "[i,i]=>i" where
    "succ_fm(x,y) == cons_fm(x,x,y)"

lemma succ_type [TC]:
     "[| x \<in> nat; y \<in> nat |] ==> succ_fm(x,y) \<in> formula"
by (simp add: succ_fm_def)

lemma sats_succ_fm [simp]:
   "[| x \<in> nat; y \<in> nat; env \<in> list(A)|]
    ==> sats(A, succ_fm(x,y), env) \<longleftrightarrow>
        successor(##A, nth(x,env), nth(y,env))"
by (simp add: succ_fm_def successor_def)

lemma successor_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; j \<in> nat; env \<in> list(A)|]
       ==> successor(##A, x, y) \<longleftrightarrow> sats(A, succ_fm(i,j), env)"
by simp

theorem successor_reflection:
     "REFLECTS[\<lambda>x. successor(L,f(x),g(x)),
               \<lambda>i x. successor(##Lset(i),f(x),g(x))]"
apply (simp only: successor_def)
apply (intro cons_reflection)
done

subsubsection\<open>The Number 1, Internalized\<close>

(* "number1(M,a) == (\<exists>x[M]. empty(M,x) & successor(M,x,a))" *)
definition
  number1_fm :: "i=>i" where
    "number1_fm(a) == Exists(And(empty_fm(0), succ_fm(0,succ(a))))"

lemma number1_type [TC]:
     "x \<in> nat ==> number1_fm(x) \<in> formula"
by (simp add: number1_fm_def)

lemma sats_number1_fm [simp]:
   "[| x \<in> nat; env \<in> list(A)|]
    ==> sats(A, number1_fm(x), env) \<longleftrightarrow> number1(##A, nth(x,env))"
by (simp add: number1_fm_def number1_def)

lemma number1_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; env \<in> list(A)|]
       ==> number1(##A, x) \<longleftrightarrow> sats(A, number1_fm(i), env)"
by simp

theorem number1_reflection:
     "REFLECTS[\<lambda>x. number1(L,f(x)),
               \<lambda>i x. number1(##Lset(i),f(x))]"
apply (simp only: number1_def)
apply (intro FOL_reflections empty_reflection successor_reflection)
done

subsubsection\<open>Big Union, Internalized\<close>

(*  "big_union(M,A,z) == \<forall>x[M]. x \<in> z \<longleftrightarrow> (\<exists>y[M]. y\<in>A & x \<in> y)" *)
definition
  big_union_fm :: "[i,i]=>i" where
    "big_union_fm(A,z) ==
       Forall(Iff(Member(0,succ(z)),
                  Exists(And(Member(0,succ(succ(A))), Member(1,0)))))"

lemma big_union_type [TC]:
     "[| x \<in> nat; y \<in> nat |] ==> big_union_fm(x,y) \<in> formula"
by (simp add: big_union_fm_def)

lemma sats_big_union_fm [simp]:
   "[| x \<in> nat; y \<in> nat; env \<in> list(A)|]
    ==> sats(A, big_union_fm(x,y), env) \<longleftrightarrow>
        big_union(##A, nth(x,env), nth(y,env))"
by (simp add: big_union_fm_def big_union_def)

lemma big_union_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; j \<in> nat; env \<in> list(A)|]
       ==> big_union(##A, x, y) \<longleftrightarrow> sats(A, big_union_fm(i,j), env)"
by simp

theorem big_union_reflection:
     "REFLECTS[\<lambda>x. big_union(L,f(x),g(x)),
               \<lambda>i x. big_union(##Lset(i),f(x),g(x))]"
apply (simp only: big_union_def)
apply (intro FOL_reflections)
done

subsubsection\<open>Variants of Satisfaction Definitions for Ordinals, etc.\<close>

text\<open>The \<open>sats\<close> theorems below are standard versions of the ones proved
in theory \<open>Formula\<close>.  They relate elements of type \<^term>\<open>formula\<close> to
relativized concepts such as \<^term>\<open>subset\<close> or \<^term>\<open>ordinal\<close> rather than to
real concepts such as \<^term>\<open>Ord\<close>.  Now that we have instantiated the locale
\<open>M_trivial\<close>, we no longer require the earlier versions.\<close>

lemma sats_subset_fm':
   "[|x \<in> nat; y \<in> nat; env \<in> list(A)|]
    ==> sats(A, subset_fm(x,y), env) \<longleftrightarrow> subset(##A, nth(x,env), nth(y,env))"
by (simp add: subset_fm_def Relative.subset_def)

theorem subset_reflection:
     "REFLECTS[\<lambda>x. subset(L,f(x),g(x)),
               \<lambda>i x. subset(##Lset(i),f(x),g(x))]"
apply (simp only: Relative.subset_def)
apply (intro FOL_reflections)
done

lemma sats_transset_fm':
   "[|x \<in> nat; env \<in> list(A)|]
    ==> sats(A, transset_fm(x), env) \<longleftrightarrow> transitive_set(##A, nth(x,env))"
by (simp add: sats_subset_fm' transset_fm_def transitive_set_def)

theorem transitive_set_reflection:
     "REFLECTS[\<lambda>x. transitive_set(L,f(x)),
               \<lambda>i x. transitive_set(##Lset(i),f(x))]"
apply (simp only: transitive_set_def)
apply (intro FOL_reflections subset_reflection)
done

lemma sats_ordinal_fm':
   "[|x \<in> nat; env \<in> list(A)|]
    ==> sats(A, ordinal_fm(x), env) \<longleftrightarrow> ordinal(##A,nth(x,env))"
by (simp add: sats_transset_fm' ordinal_fm_def ordinal_def)

lemma ordinal_iff_sats:
      "[| nth(i,env) = x;  i \<in> nat; env \<in> list(A)|]
       ==> ordinal(##A, x) \<longleftrightarrow> sats(A, ordinal_fm(i), env)"
by (simp add: sats_ordinal_fm')

theorem ordinal_reflection:
     "REFLECTS[\<lambda>x. ordinal(L,f(x)), \<lambda>i x. ordinal(##Lset(i),f(x))]"
apply (simp only: ordinal_def)
apply (intro FOL_reflections transitive_set_reflection)
done

subsubsection\<open>Membership Relation, Internalized\<close>

definition
  Memrel_fm :: "[i,i]=>i" where
    "Memrel_fm(A,r) ==
       Forall(Iff(Member(0,succ(r)),
                  Exists(And(Member(0,succ(succ(A))),
                             Exists(And(Member(0,succ(succ(succ(A)))),
                                        And(Member(1,0),
                                            pair_fm(1,0,2))))))))"

lemma Memrel_type [TC]:
     "[| x \<in> nat; y \<in> nat |] ==> Memrel_fm(x,y) \<in> formula"
by (simp add: Memrel_fm_def)

lemma sats_Memrel_fm [simp]:
   "[| x \<in> nat; y \<in> nat; env \<in> list(A)|]
    ==> sats(A, Memrel_fm(x,y), env) \<longleftrightarrow>
        membership(##A, nth(x,env), nth(y,env))"
by (simp add: Memrel_fm_def membership_def)

lemma Memrel_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; j \<in> nat; env \<in> list(A)|]
       ==> membership(##A, x, y) \<longleftrightarrow> sats(A, Memrel_fm(i,j), env)"
by simp

theorem membership_reflection:
     "REFLECTS[\<lambda>x. membership(L,f(x),g(x)),
               \<lambda>i x. membership(##Lset(i),f(x),g(x))]"
apply (simp only: membership_def)
apply (intro FOL_reflections pair_reflection)
done

subsubsection\<open>Predecessor Set, Internalized\<close>

definition
  pred_set_fm :: "[i,i,i,i]=>i" where
    "pred_set_fm(A,x,r,B) ==
       Forall(Iff(Member(0,succ(B)),
                  Exists(And(Member(0,succ(succ(r))),
                             And(Member(1,succ(succ(A))),
                                 pair_fm(1,succ(succ(x)),0))))))"

lemma pred_set_type [TC]:
     "[| A \<in> nat; x \<in> nat; r \<in> nat; B \<in> nat |]
      ==> pred_set_fm(A,x,r,B) \<in> formula"
by (simp add: pred_set_fm_def)

lemma sats_pred_set_fm [simp]:
   "[| U \<in> nat; x \<in> nat; r \<in> nat; B \<in> nat; env \<in> list(A)|]
    ==> sats(A, pred_set_fm(U,x,r,B), env) \<longleftrightarrow>
        pred_set(##A, nth(U,env), nth(x,env), nth(r,env), nth(B,env))"
by (simp add: pred_set_fm_def pred_set_def)

lemma pred_set_iff_sats:
      "[| nth(i,env) = U; nth(j,env) = x; nth(k,env) = r; nth(l,env) = B;
          i \<in> nat; j \<in> nat; k \<in> nat; l \<in> nat; env \<in> list(A)|]
       ==> pred_set(##A,U,x,r,B) \<longleftrightarrow> sats(A, pred_set_fm(i,j,k,l), env)"
by (simp)

theorem pred_set_reflection:
     "REFLECTS[\<lambda>x. pred_set(L,f(x),g(x),h(x),b(x)),
               \<lambda>i x. pred_set(##Lset(i),f(x),g(x),h(x),b(x))]"
apply (simp only: pred_set_def)
apply (intro FOL_reflections pair_reflection)
done

subsubsection\<open>Domain of a Relation, Internalized\<close>

(* "is_domain(M,r,z) ==
        \<forall>x[M]. (x \<in> z \<longleftrightarrow> (\<exists>w[M]. w\<in>r & (\<exists>y[M]. pair(M,x,y,w))))" *)
definition
  domain_fm :: "[i,i]=>i" where
    "domain_fm(r,z) ==
       Forall(Iff(Member(0,succ(z)),
                  Exists(And(Member(0,succ(succ(r))),
                             Exists(pair_fm(2,0,1))))))"

lemma domain_type [TC]:
     "[| x \<in> nat; y \<in> nat |] ==> domain_fm(x,y) \<in> formula"
by (simp add: domain_fm_def)

lemma sats_domain_fm [simp]:
   "[| x \<in> nat; y \<in> nat; env \<in> list(A)|]
    ==> sats(A, domain_fm(x,y), env) \<longleftrightarrow>
        is_domain(##A, nth(x,env), nth(y,env))"
by (simp add: domain_fm_def is_domain_def)

lemma domain_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; j \<in> nat; env \<in> list(A)|]
       ==> is_domain(##A, x, y) \<longleftrightarrow> sats(A, domain_fm(i,j), env)"
by simp

theorem domain_reflection:
     "REFLECTS[\<lambda>x. is_domain(L,f(x),g(x)),
               \<lambda>i x. is_domain(##Lset(i),f(x),g(x))]"
apply (simp only: is_domain_def)
apply (intro FOL_reflections pair_reflection)
done

subsubsection\<open>Range of a Relation, Internalized\<close>

(* "is_range(M,r,z) ==
        \<forall>y[M]. (y \<in> z \<longleftrightarrow> (\<exists>w[M]. w\<in>r & (\<exists>x[M]. pair(M,x,y,w))))" *)
definition
  range_fm :: "[i,i]=>i" where
    "range_fm(r,z) ==
       Forall(Iff(Member(0,succ(z)),
                  Exists(And(Member(0,succ(succ(r))),
                             Exists(pair_fm(0,2,1))))))"

lemma range_type [TC]:
     "[| x \<in> nat; y \<in> nat |] ==> range_fm(x,y) \<in> formula"
by (simp add: range_fm_def)

lemma sats_range_fm [simp]:
   "[| x \<in> nat; y \<in> nat; env \<in> list(A)|]
    ==> sats(A, range_fm(x,y), env) \<longleftrightarrow>
        is_range(##A, nth(x,env), nth(y,env))"
by (simp add: range_fm_def is_range_def)

lemma range_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; j \<in> nat; env \<in> list(A)|]
       ==> is_range(##A, x, y) \<longleftrightarrow> sats(A, range_fm(i,j), env)"
by simp

theorem range_reflection:
     "REFLECTS[\<lambda>x. is_range(L,f(x),g(x)),
               \<lambda>i x. is_range(##Lset(i),f(x),g(x))]"
apply (simp only: is_range_def)
apply (intro FOL_reflections pair_reflection)
done

subsubsection\<open>Field of a Relation, Internalized\<close>

(* "is_field(M,r,z) ==
        \<exists>dr[M]. is_domain(M,r,dr) &
            (\<exists>rr[M]. is_range(M,r,rr) & union(M,dr,rr,z))" *)
definition
  field_fm :: "[i,i]=>i" where
    "field_fm(r,z) ==
       Exists(And(domain_fm(succ(r),0),
              Exists(And(range_fm(succ(succ(r)),0),
                         union_fm(1,0,succ(succ(z)))))))"

lemma field_type [TC]:
     "[| x \<in> nat; y \<in> nat |] ==> field_fm(x,y) \<in> formula"
by (simp add: field_fm_def)

lemma sats_field_fm [simp]:
   "[| x \<in> nat; y \<in> nat; env \<in> list(A)|]
    ==> sats(A, field_fm(x,y), env) \<longleftrightarrow>
        is_field(##A, nth(x,env), nth(y,env))"
by (simp add: field_fm_def is_field_def)

lemma field_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; j \<in> nat; env \<in> list(A)|]
       ==> is_field(##A, x, y) \<longleftrightarrow> sats(A, field_fm(i,j), env)"
by simp

theorem field_reflection:
     "REFLECTS[\<lambda>x. is_field(L,f(x),g(x)),
               \<lambda>i x. is_field(##Lset(i),f(x),g(x))]"
apply (simp only: is_field_def)
apply (intro FOL_reflections domain_reflection range_reflection
             union_reflection)
done

subsubsection\<open>Image under a Relation, Internalized\<close>

(* "image(M,r,A,z) ==
        \<forall>y[M]. (y \<in> z \<longleftrightarrow> (\<exists>w[M]. w\<in>r & (\<exists>x[M]. x\<in>A & pair(M,x,y,w))))" *)
definition
  image_fm :: "[i,i,i]=>i" where
    "image_fm(r,A,z) ==
       Forall(Iff(Member(0,succ(z)),
                  Exists(And(Member(0,succ(succ(r))),
                             Exists(And(Member(0,succ(succ(succ(A)))),
                                        pair_fm(0,2,1)))))))"

lemma image_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> image_fm(x,y,z) \<in> formula"
by (simp add: image_fm_def)

lemma sats_image_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, image_fm(x,y,z), env) \<longleftrightarrow>
        image(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: image_fm_def Relative.image_def)

lemma image_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> image(##A, x, y, z) \<longleftrightarrow> sats(A, image_fm(i,j,k), env)"
by (simp)

theorem image_reflection:
     "REFLECTS[\<lambda>x. image(L,f(x),g(x),h(x)),
               \<lambda>i x. image(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: Relative.image_def)
apply (intro FOL_reflections pair_reflection)
done

subsubsection\<open>Pre-Image under a Relation, Internalized\<close>

(* "pre_image(M,r,A,z) ==
        \<forall>x[M]. x \<in> z \<longleftrightarrow> (\<exists>w[M]. w\<in>r & (\<exists>y[M]. y\<in>A & pair(M,x,y,w)))" *)
definition
  pre_image_fm :: "[i,i,i]=>i" where
    "pre_image_fm(r,A,z) ==
       Forall(Iff(Member(0,succ(z)),
                  Exists(And(Member(0,succ(succ(r))),
                             Exists(And(Member(0,succ(succ(succ(A)))),
                                        pair_fm(2,0,1)))))))"

lemma pre_image_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> pre_image_fm(x,y,z) \<in> formula"
by (simp add: pre_image_fm_def)

lemma sats_pre_image_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, pre_image_fm(x,y,z), env) \<longleftrightarrow>
        pre_image(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: pre_image_fm_def Relative.pre_image_def)

lemma pre_image_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> pre_image(##A, x, y, z) \<longleftrightarrow> sats(A, pre_image_fm(i,j,k), env)"
by (simp)

theorem pre_image_reflection:
     "REFLECTS[\<lambda>x. pre_image(L,f(x),g(x),h(x)),
               \<lambda>i x. pre_image(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: Relative.pre_image_def)
apply (intro FOL_reflections pair_reflection)
done

subsubsection\<open>Function Application, Internalized\<close>

(* "fun_apply(M,f,x,y) ==
        (\<exists>xs[M]. \<exists>fxs[M].
         upair(M,x,x,xs) & image(M,f,xs,fxs) & big_union(M,fxs,y))" *)
definition
  fun_apply_fm :: "[i,i,i]=>i" where
    "fun_apply_fm(f,x,y) ==
       Exists(Exists(And(upair_fm(succ(succ(x)), succ(succ(x)), 1),
                         And(image_fm(succ(succ(f)), 1, 0),
                             big_union_fm(0,succ(succ(y)))))))"

lemma fun_apply_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> fun_apply_fm(x,y,z) \<in> formula"
by (simp add: fun_apply_fm_def)

lemma sats_fun_apply_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, fun_apply_fm(x,y,z), env) \<longleftrightarrow>
        fun_apply(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: fun_apply_fm_def fun_apply_def)

lemma fun_apply_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> fun_apply(##A, x, y, z) \<longleftrightarrow> sats(A, fun_apply_fm(i,j,k), env)"
by simp

theorem fun_apply_reflection:
     "REFLECTS[\<lambda>x. fun_apply(L,f(x),g(x),h(x)),
               \<lambda>i x. fun_apply(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: fun_apply_def)
apply (intro FOL_reflections upair_reflection image_reflection
             big_union_reflection)
done

subsubsection\<open>The Concept of Relation, Internalized\<close>

(* "is_relation(M,r) ==
        (\<forall>z[M]. z\<in>r \<longrightarrow> (\<exists>x[M]. \<exists>y[M]. pair(M,x,y,z)))" *)
definition
  relation_fm :: "i=>i" where
    "relation_fm(r) ==
       Forall(Implies(Member(0,succ(r)), Exists(Exists(pair_fm(1,0,2)))))"

lemma relation_type [TC]:
     "[| x \<in> nat |] ==> relation_fm(x) \<in> formula"
by (simp add: relation_fm_def)

lemma sats_relation_fm [simp]:
   "[| x \<in> nat; env \<in> list(A)|]
    ==> sats(A, relation_fm(x), env) \<longleftrightarrow> is_relation(##A, nth(x,env))"
by (simp add: relation_fm_def is_relation_def)

lemma relation_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; env \<in> list(A)|]
       ==> is_relation(##A, x) \<longleftrightarrow> sats(A, relation_fm(i), env)"
by simp

theorem is_relation_reflection:
     "REFLECTS[\<lambda>x. is_relation(L,f(x)),
               \<lambda>i x. is_relation(##Lset(i),f(x))]"
apply (simp only: is_relation_def)
apply (intro FOL_reflections pair_reflection)
done

subsubsection\<open>The Concept of Function, Internalized\<close>

(* "is_function(M,r) ==
        \<forall>x[M]. \<forall>y[M]. \<forall>y'[M]. \<forall>p[M]. \<forall>p'[M].
           pair(M,x,y,p) \<longrightarrow> pair(M,x,y',p') \<longrightarrow> p\<in>r \<longrightarrow> p'\<in>r \<longrightarrow> y=y'" *)
definition
  function_fm :: "i=>i" where
    "function_fm(r) ==
       Forall(Forall(Forall(Forall(Forall(
         Implies(pair_fm(4,3,1),
                 Implies(pair_fm(4,2,0),
                         Implies(Member(1,r#+5),
                                 Implies(Member(0,r#+5), Equal(3,2))))))))))"

lemma function_type [TC]:
     "[| x \<in> nat |] ==> function_fm(x) \<in> formula"
by (simp add: function_fm_def)

lemma sats_function_fm [simp]:
   "[| x \<in> nat; env \<in> list(A)|]
    ==> sats(A, function_fm(x), env) \<longleftrightarrow> is_function(##A, nth(x,env))"
by (simp add: function_fm_def is_function_def)

lemma is_function_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; env \<in> list(A)|]
       ==> is_function(##A, x) \<longleftrightarrow> sats(A, function_fm(i), env)"
by simp

theorem is_function_reflection:
     "REFLECTS[\<lambda>x. is_function(L,f(x)),
               \<lambda>i x. is_function(##Lset(i),f(x))]"
apply (simp only: is_function_def)
apply (intro FOL_reflections pair_reflection)
done

subsubsection\<open>Typed Functions, Internalized\<close>

(* "typed_function(M,A,B,r) ==
        is_function(M,r) & is_relation(M,r) & is_domain(M,r,A) &
        (\<forall>u[M]. u\<in>r \<longrightarrow> (\<forall>x[M]. \<forall>y[M]. pair(M,x,y,u) \<longrightarrow> y\<in>B))" *)

definition
  typed_function_fm :: "[i,i,i]=>i" where
    "typed_function_fm(A,B,r) ==
       And(function_fm(r),
         And(relation_fm(r),
           And(domain_fm(r,A),
             Forall(Implies(Member(0,succ(r)),
                  Forall(Forall(Implies(pair_fm(1,0,2),Member(0,B#+3)))))))))"

lemma typed_function_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> typed_function_fm(x,y,z) \<in> formula"
by (simp add: typed_function_fm_def)

lemma sats_typed_function_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, typed_function_fm(x,y,z), env) \<longleftrightarrow>
        typed_function(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: typed_function_fm_def typed_function_def)

lemma typed_function_iff_sats:
  "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
      i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
   ==> typed_function(##A, x, y, z) \<longleftrightarrow> sats(A, typed_function_fm(i,j,k), env)"
by simp

lemmas function_reflections =
        empty_reflection number1_reflection
        upair_reflection pair_reflection union_reflection
        big_union_reflection cons_reflection successor_reflection
        fun_apply_reflection subset_reflection
        transitive_set_reflection membership_reflection
        pred_set_reflection domain_reflection range_reflection field_reflection
        image_reflection pre_image_reflection
        is_relation_reflection is_function_reflection

lemmas function_iff_sats =
        empty_iff_sats number1_iff_sats
        upair_iff_sats pair_iff_sats union_iff_sats
        big_union_iff_sats cons_iff_sats successor_iff_sats
        fun_apply_iff_sats  Memrel_iff_sats
        pred_set_iff_sats domain_iff_sats range_iff_sats field_iff_sats
        image_iff_sats pre_image_iff_sats
        relation_iff_sats is_function_iff_sats

theorem typed_function_reflection:
     "REFLECTS[\<lambda>x. typed_function(L,f(x),g(x),h(x)),
               \<lambda>i x. typed_function(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: typed_function_def)
apply (intro FOL_reflections function_reflections)
done

subsubsection\<open>Composition of Relations, Internalized\<close>

(* "composition(M,r,s,t) ==
        \<forall>p[M]. p \<in> t \<longleftrightarrow>
               (\<exists>x[M]. \<exists>y[M]. \<exists>z[M]. \<exists>xy[M]. \<exists>yz[M].
                pair(M,x,z,p) & pair(M,x,y,xy) & pair(M,y,z,yz) &
                xy \<in> s & yz \<in> r)" *)
definition
  composition_fm :: "[i,i,i]=>i" where
  "composition_fm(r,s,t) ==
     Forall(Iff(Member(0,succ(t)),
             Exists(Exists(Exists(Exists(Exists(
              And(pair_fm(4,2,5),
               And(pair_fm(4,3,1),
                And(pair_fm(3,2,0),
                 And(Member(1,s#+6), Member(0,r#+6))))))))))))"

lemma composition_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> composition_fm(x,y,z) \<in> formula"
by (simp add: composition_fm_def)

lemma sats_composition_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, composition_fm(x,y,z), env) \<longleftrightarrow>
        composition(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: composition_fm_def composition_def)

lemma composition_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> composition(##A, x, y, z) \<longleftrightarrow> sats(A, composition_fm(i,j,k), env)"
by simp

theorem composition_reflection:
     "REFLECTS[\<lambda>x. composition(L,f(x),g(x),h(x)),
               \<lambda>i x. composition(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: composition_def)
apply (intro FOL_reflections pair_reflection)
done

subsubsection\<open>Injections, Internalized\<close>

(* "injection(M,A,B,f) ==
        typed_function(M,A,B,f) &
        (\<forall>x[M]. \<forall>x'[M]. \<forall>y[M]. \<forall>p[M]. \<forall>p'[M].
          pair(M,x,y,p) \<longrightarrow> pair(M,x',y,p') \<longrightarrow> p\<in>f \<longrightarrow> p'\<in>f \<longrightarrow> x=x')" *)
definition
  injection_fm :: "[i,i,i]=>i" where
  "injection_fm(A,B,f) ==
    And(typed_function_fm(A,B,f),
       Forall(Forall(Forall(Forall(Forall(
         Implies(pair_fm(4,2,1),
                 Implies(pair_fm(3,2,0),
                         Implies(Member(1,f#+5),
                                 Implies(Member(0,f#+5), Equal(4,3)))))))))))"

lemma injection_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> injection_fm(x,y,z) \<in> formula"
by (simp add: injection_fm_def)

lemma sats_injection_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, injection_fm(x,y,z), env) \<longleftrightarrow>
        injection(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: injection_fm_def injection_def)

lemma injection_iff_sats:
  "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
      i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
   ==> injection(##A, x, y, z) \<longleftrightarrow> sats(A, injection_fm(i,j,k), env)"
by simp

theorem injection_reflection:
     "REFLECTS[\<lambda>x. injection(L,f(x),g(x),h(x)),
               \<lambda>i x. injection(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: injection_def)
apply (intro FOL_reflections function_reflections typed_function_reflection)
done

subsubsection\<open>Surjections, Internalized\<close>

(*  surjection :: "[i=>o,i,i,i] => o"
    "surjection(M,A,B,f) ==
        typed_function(M,A,B,f) &
        (\<forall>y[M]. y\<in>B \<longrightarrow> (\<exists>x[M]. x\<in>A & fun_apply(M,f,x,y)))" *)
definition
  surjection_fm :: "[i,i,i]=>i" where
  "surjection_fm(A,B,f) ==
    And(typed_function_fm(A,B,f),
       Forall(Implies(Member(0,succ(B)),
                      Exists(And(Member(0,succ(succ(A))),
                                 fun_apply_fm(succ(succ(f)),0,1))))))"

lemma surjection_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> surjection_fm(x,y,z) \<in> formula"
by (simp add: surjection_fm_def)

lemma sats_surjection_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, surjection_fm(x,y,z), env) \<longleftrightarrow>
        surjection(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: surjection_fm_def surjection_def)

lemma surjection_iff_sats:
  "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
      i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
   ==> surjection(##A, x, y, z) \<longleftrightarrow> sats(A, surjection_fm(i,j,k), env)"
by simp

theorem surjection_reflection:
     "REFLECTS[\<lambda>x. surjection(L,f(x),g(x),h(x)),
               \<lambda>i x. surjection(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: surjection_def)
apply (intro FOL_reflections function_reflections typed_function_reflection)
done

subsubsection\<open>Bijections, Internalized\<close>

(*   bijection :: "[i=>o,i,i,i] => o"
    "bijection(M,A,B,f) == injection(M,A,B,f) & surjection(M,A,B,f)" *)
definition
  bijection_fm :: "[i,i,i]=>i" where
  "bijection_fm(A,B,f) == And(injection_fm(A,B,f), surjection_fm(A,B,f))"

lemma bijection_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> bijection_fm(x,y,z) \<in> formula"
by (simp add: bijection_fm_def)

lemma sats_bijection_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, bijection_fm(x,y,z), env) \<longleftrightarrow>
        bijection(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: bijection_fm_def bijection_def)

lemma bijection_iff_sats:
  "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
      i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
   ==> bijection(##A, x, y, z) \<longleftrightarrow> sats(A, bijection_fm(i,j,k), env)"
by simp

theorem bijection_reflection:
     "REFLECTS[\<lambda>x. bijection(L,f(x),g(x),h(x)),
               \<lambda>i x. bijection(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: bijection_def)
apply (intro And_reflection injection_reflection surjection_reflection)
done

subsubsection\<open>Restriction of a Relation, Internalized\<close>

(* "restriction(M,r,A,z) ==
        \<forall>x[M]. x \<in> z \<longleftrightarrow> (x \<in> r & (\<exists>u[M]. u\<in>A & (\<exists>v[M]. pair(M,u,v,x))))" *)
definition
  restriction_fm :: "[i,i,i]=>i" where
    "restriction_fm(r,A,z) ==
       Forall(Iff(Member(0,succ(z)),
                  And(Member(0,succ(r)),
                      Exists(And(Member(0,succ(succ(A))),
                                 Exists(pair_fm(1,0,2)))))))"

lemma restriction_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> restriction_fm(x,y,z) \<in> formula"
by (simp add: restriction_fm_def)

lemma sats_restriction_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, restriction_fm(x,y,z), env) \<longleftrightarrow>
        restriction(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: restriction_fm_def restriction_def)

lemma restriction_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> restriction(##A, x, y, z) \<longleftrightarrow> sats(A, restriction_fm(i,j,k), env)"
by simp

theorem restriction_reflection:
     "REFLECTS[\<lambda>x. restriction(L,f(x),g(x),h(x)),
               \<lambda>i x. restriction(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: restriction_def)
apply (intro FOL_reflections pair_reflection)
done

subsubsection\<open>Order-Isomorphisms, Internalized\<close>

(*  order_isomorphism :: "[i=>o,i,i,i,i,i] => o"
   "order_isomorphism(M,A,r,B,s,f) ==
        bijection(M,A,B,f) &
        (\<forall>x[M]. x\<in>A \<longrightarrow> (\<forall>y[M]. y\<in>A \<longrightarrow>
          (\<forall>p[M]. \<forall>fx[M]. \<forall>fy[M]. \<forall>q[M].
            pair(M,x,y,p) \<longrightarrow> fun_apply(M,f,x,fx) \<longrightarrow> fun_apply(M,f,y,fy) \<longrightarrow>
            pair(M,fx,fy,q) \<longrightarrow> (p\<in>r \<longleftrightarrow> q\<in>s))))"
  *)

definition
  order_isomorphism_fm :: "[i,i,i,i,i]=>i" where
 "order_isomorphism_fm(A,r,B,s,f) ==
   And(bijection_fm(A,B,f),
     Forall(Implies(Member(0,succ(A)),
       Forall(Implies(Member(0,succ(succ(A))),
         Forall(Forall(Forall(Forall(
           Implies(pair_fm(5,4,3),
             Implies(fun_apply_fm(f#+6,5,2),
               Implies(fun_apply_fm(f#+6,4,1),
                 Implies(pair_fm(2,1,0),
                   Iff(Member(3,r#+6), Member(0,s#+6)))))))))))))))"

lemma order_isomorphism_type [TC]:
     "[| A \<in> nat; r \<in> nat; B \<in> nat; s \<in> nat; f \<in> nat |]
      ==> order_isomorphism_fm(A,r,B,s,f) \<in> formula"
by (simp add: order_isomorphism_fm_def)

lemma sats_order_isomorphism_fm [simp]:
   "[| U \<in> nat; r \<in> nat; B \<in> nat; s \<in> nat; f \<in> nat; env \<in> list(A)|]
    ==> sats(A, order_isomorphism_fm(U,r,B,s,f), env) \<longleftrightarrow>
        order_isomorphism(##A, nth(U,env), nth(r,env), nth(B,env),
                               nth(s,env), nth(f,env))"
by (simp add: order_isomorphism_fm_def order_isomorphism_def)

lemma order_isomorphism_iff_sats:
  "[| nth(i,env) = U; nth(j,env) = r; nth(k,env) = B; nth(j',env) = s;
      nth(k',env) = f;
      i \<in> nat; j \<in> nat; k \<in> nat; j' \<in> nat; k' \<in> nat; env \<in> list(A)|]
   ==> order_isomorphism(##A,U,r,B,s,f) \<longleftrightarrow>
       sats(A, order_isomorphism_fm(i,j,k,j',k'), env)"
by simp

theorem order_isomorphism_reflection:
     "REFLECTS[\<lambda>x. order_isomorphism(L,f(x),g(x),h(x),g'(x),h'(x)),
               \<lambda>i x. order_isomorphism(##Lset(i),f(x),g(x),h(x),g'(x),h'(x))]"
apply (simp only: order_isomorphism_def)
apply (intro FOL_reflections function_reflections bijection_reflection)
done

subsubsection\<open>Limit Ordinals, Internalized\<close>

text\<open>A limit ordinal is a non-empty, successor-closed ordinal\<close>

(* "limit_ordinal(M,a) ==
        ordinal(M,a) & ~ empty(M,a) &
        (\<forall>x[M]. x\<in>a \<longrightarrow> (\<exists>y[M]. y\<in>a & successor(M,x,y)))" *)

definition
  limit_ordinal_fm :: "i=>i" where
    "limit_ordinal_fm(x) ==
        And(ordinal_fm(x),
            And(Neg(empty_fm(x)),
                Forall(Implies(Member(0,succ(x)),
                               Exists(And(Member(0,succ(succ(x))),
                                          succ_fm(1,0)))))))"

lemma limit_ordinal_type [TC]:
     "x \<in> nat ==> limit_ordinal_fm(x) \<in> formula"
by (simp add: limit_ordinal_fm_def)

lemma sats_limit_ordinal_fm [simp]:
   "[| x \<in> nat; env \<in> list(A)|]
    ==> sats(A, limit_ordinal_fm(x), env) \<longleftrightarrow> limit_ordinal(##A, nth(x,env))"
by (simp add: limit_ordinal_fm_def limit_ordinal_def sats_ordinal_fm')

lemma limit_ordinal_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; env \<in> list(A)|]
       ==> limit_ordinal(##A, x) \<longleftrightarrow> sats(A, limit_ordinal_fm(i), env)"
by simp

theorem limit_ordinal_reflection:
     "REFLECTS[\<lambda>x. limit_ordinal(L,f(x)),
               \<lambda>i x. limit_ordinal(##Lset(i),f(x))]"
apply (simp only: limit_ordinal_def)
apply (intro FOL_reflections ordinal_reflection
             empty_reflection successor_reflection)
done

subsubsection\<open>Finite Ordinals: The Predicate ``Is A Natural Number''\<close>

(*     "finite_ordinal(M,a) ==
        ordinal(M,a) & ~ limit_ordinal(M,a) &
        (\<forall>x[M]. x\<in>a \<longrightarrow> ~ limit_ordinal(M,x))" *)
definition
  finite_ordinal_fm :: "i=>i" where
    "finite_ordinal_fm(x) ==
       And(ordinal_fm(x),
          And(Neg(limit_ordinal_fm(x)),
           Forall(Implies(Member(0,succ(x)),
                          Neg(limit_ordinal_fm(0))))))"

lemma finite_ordinal_type [TC]:
     "x \<in> nat ==> finite_ordinal_fm(x) \<in> formula"
by (simp add: finite_ordinal_fm_def)

lemma sats_finite_ordinal_fm [simp]:
   "[| x \<in> nat; env \<in> list(A)|]
    ==> sats(A, finite_ordinal_fm(x), env) \<longleftrightarrow> finite_ordinal(##A, nth(x,env))"
by (simp add: finite_ordinal_fm_def sats_ordinal_fm' finite_ordinal_def)

lemma finite_ordinal_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; env \<in> list(A)|]
       ==> finite_ordinal(##A, x) \<longleftrightarrow> sats(A, finite_ordinal_fm(i), env)"
by simp

theorem finite_ordinal_reflection:
     "REFLECTS[\<lambda>x. finite_ordinal(L,f(x)),
               \<lambda>i x. finite_ordinal(##Lset(i),f(x))]"
apply (simp only: finite_ordinal_def)
apply (intro FOL_reflections ordinal_reflection limit_ordinal_reflection)
done

subsubsection\<open>Omega: The Set of Natural Numbers\<close>

(* omega(M,a) == limit_ordinal(M,a) & (\<forall>x[M]. x\<in>a \<longrightarrow> ~ limit_ordinal(M,x)) *)
definition
  omega_fm :: "i=>i" where
    "omega_fm(x) ==
       And(limit_ordinal_fm(x),
           Forall(Implies(Member(0,succ(x)),
                          Neg(limit_ordinal_fm(0)))))"

lemma omega_type [TC]:
     "x \<in> nat ==> omega_fm(x) \<in> formula"
by (simp add: omega_fm_def)

lemma sats_omega_fm [simp]:
   "[| x \<in> nat; env \<in> list(A)|]
    ==> sats(A, omega_fm(x), env) \<longleftrightarrow> omega(##A, nth(x,env))"
by (simp add: omega_fm_def omega_def)

lemma omega_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; env \<in> list(A)|]
       ==> omega(##A, x) \<longleftrightarrow> sats(A, omega_fm(i), env)"
by simp

theorem omega_reflection:
     "REFLECTS[\<lambda>x. omega(L,f(x)),
               \<lambda>i x. omega(##Lset(i),f(x))]"
apply (simp only: omega_def)
apply (intro FOL_reflections limit_ordinal_reflection)
done

lemmas fun_plus_reflections =
        typed_function_reflection composition_reflection
        injection_reflection surjection_reflection
        bijection_reflection restriction_reflection
        order_isomorphism_reflection finite_ordinal_reflection
        ordinal_reflection limit_ordinal_reflection omega_reflection

lemmas fun_plus_iff_sats =
        typed_function_iff_sats composition_iff_sats
        injection_iff_sats surjection_iff_sats
        bijection_iff_sats restriction_iff_sats
        order_isomorphism_iff_sats finite_ordinal_iff_sats
        ordinal_iff_sats limit_ordinal_iff_sats omega_iff_sats

end


theory Classes
imports Main Setup
begin

section {* Introduction *}

text {*
  Type classes were introduced by Wadler and Blott @{cite wadler89how}
  into the Haskell language to allow for a reasonable implementation
  of overloading\footnote{throughout this tutorial, we are referring
  to classical Haskell 1.0 type classes, not considering later
  additions in expressiveness}.  As a canonical example, a polymorphic
  equality function @{text "eq \<Colon> \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool"} which is overloaded on
  different types for @{text "\<alpha>"}, which is achieved by splitting
  introduction of the @{text eq} function from its overloaded
  definitions by means of @{text class} and @{text instance}
  declarations: \footnote{syntax here is a kind of isabellized
  Haskell}

  \begin{quote}

  \noindent@{text "class eq where"} \\
  \hspace*{2ex}@{text "eq \<Colon> \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool"}

  \medskip\noindent@{text "instance nat \<Colon> eq where"} \\
  \hspace*{2ex}@{text "eq 0 0 = True"} \\
  \hspace*{2ex}@{text "eq 0 _ = False"} \\
  \hspace*{2ex}@{text "eq _ 0 = False"} \\
  \hspace*{2ex}@{text "eq (Suc n) (Suc m) = eq n m"}

  \medskip\noindent@{text "instance (\<alpha>\<Colon>eq, \<beta>\<Colon>eq) pair \<Colon> eq where"} \\
  \hspace*{2ex}@{text "eq (x1, y1) (x2, y2) = eq x1 x2 \<and> eq y1 y2"}

  \medskip\noindent@{text "class ord extends eq where"} \\
  \hspace*{2ex}@{text "less_eq \<Colon> \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool"} \\
  \hspace*{2ex}@{text "less \<Colon> \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool"}

  \end{quote}

  \noindent Type variables are annotated with (finitely many) classes;
  these annotations are assertions that a particular polymorphic type
  provides definitions for overloaded functions.

  Indeed, type classes not only allow for simple overloading but form
  a generic calculus, an instance of order-sorted algebra
  @{cite "nipkow-sorts93" and "Nipkow-Prehofer:1993" and "Wenzel:1997:TPHOL"}.

  From a software engineering point of view, type classes roughly
  correspond to interfaces in object-oriented languages like Java; so,
  it is naturally desirable that type classes do not only provide
  functions (class parameters) but also state specifications
  implementations must obey.  For example, the @{text "class eq"}
  above could be given the following specification, demanding that
  @{text "class eq"} is an equivalence relation obeying reflexivity,
  symmetry and transitivity:

  \begin{quote}

  \noindent@{text "class eq where"} \\
  \hspace*{2ex}@{text "eq \<Colon> \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool"} \\
  @{text "satisfying"} \\
  \hspace*{2ex}@{text "refl: eq x x"} \\
  \hspace*{2ex}@{text "sym: eq x y \<longleftrightarrow> eq x y"} \\
  \hspace*{2ex}@{text "trans: eq x y \<and> eq y z \<longrightarrow> eq x z"}

  \end{quote}

  \noindent From a theoretical point of view, type classes are
  lightweight modules; Haskell type classes may be emulated by SML
  functors @{cite classes_modules}.  Isabelle/Isar offers a discipline
  of type classes which brings all those aspects together:

  \begin{enumerate}
    \item specifying abstract parameters together with
       corresponding specifications,
    \item instantiating those abstract parameters by a particular
       type
    \item in connection with a ``less ad-hoc'' approach to overloading,
    \item with a direct link to the Isabelle module system:
      locales @{cite "kammueller-locales"}.
  \end{enumerate}

  \noindent Isar type classes also directly support code generation in
  a Haskell like fashion. Internally, they are mapped to more
  primitive Isabelle concepts @{cite "Haftmann-Wenzel:2006:classes"}.

  This tutorial demonstrates common elements of structured
  specifications and abstract reasoning with type classes by the
  algebraic hierarchy of semigroups, monoids and groups.  Our
  background theory is that of Isabelle/HOL @{cite "isa-tutorial"}, for
  which some familiarity is assumed.
*}

section {* A simple algebra example \label{sec:example} *}

subsection {* Class definition *}

text {*
  Depending on an arbitrary type @{text "\<alpha>"}, class @{text
  "semigroup"} introduces a binary operator @{text "(\<otimes>)"} that is
  assumed to be associative:
*}

class %quote semigroup =
  fixes mult :: "\<alpha> \<Rightarrow> \<alpha> \<Rightarrow> \<alpha>"    (infixl "\<otimes>" 70)
  assumes assoc: "(x \<otimes> y) \<otimes> z = x \<otimes> (y \<otimes> z)"

text {*
  \noindent This @{command class} specification consists of two parts:
  the \qn{operational} part names the class parameter (@{element
  "fixes"}), the \qn{logical} part specifies properties on them
  (@{element "assumes"}).  The local @{element "fixes"} and @{element
  "assumes"} are lifted to the theory toplevel, yielding the global
  parameter @{term [source] "mult \<Colon> \<alpha>\<Colon>semigroup \<Rightarrow> \<alpha> \<Rightarrow> \<alpha>"} and the
  global theorem @{fact "semigroup.assoc:"}~@{prop [source] "\<And>x y z \<Colon>
  \<alpha>\<Colon>semigroup. (x \<otimes> y) \<otimes> z = x \<otimes> (y \<otimes> z)"}.
*}

subsection {* Class instantiation \label{sec:class_inst} *}

text {*
  The concrete type @{typ int} is made a @{class semigroup} instance
  by providing a suitable definition for the class parameter @{text
  "(\<otimes>)"} and a proof for the specification of @{fact assoc}.  This is
  accomplished by the @{command instantiation} target:
*}

instantiation %quote int :: semigroup
begin

definition %quote
  mult_int_def: "i \<otimes> j = i + (j\<Colon>int)"

instance %quote proof
  fix i j k :: int have "(i + j) + k = i + (j + k)" by simp
  then show "(i \<otimes> j) \<otimes> k = i \<otimes> (j \<otimes> k)"
    unfolding mult_int_def .
qed

end %quote

text {*
  \noindent @{command instantiation} defines class parameters at a
  particular instance using common specification tools (here,
  @{command definition}).  The concluding @{command instance} opens a
  proof that the given parameters actually conform to the class
  specification.  Note that the first proof step is the @{method
  default} method, which for such instance proofs maps to the @{method
  intro_classes} method.  This reduces an instance judgement to the
  relevant primitive proof goals; typically it is the first method
  applied in an instantiation proof.

  From now on, the type-checker will consider @{typ int} as a @{class
  semigroup} automatically, i.e.\ any general results are immediately
  available on concrete instances.

  \medskip Another instance of @{class semigroup} yields the natural
  numbers:
*}

instantiation %quote nat :: semigroup
begin

primrec %quote mult_nat where
  "(0\<Colon>nat) \<otimes> n = n"
  | "Suc m \<otimes> n = Suc (m \<otimes> n)"

instance %quote proof
  fix m n q :: nat
  show "m \<otimes> n \<otimes> q = m \<otimes> (n \<otimes> q)"
    by (induct m) auto
qed

end %quote

text {*
  \noindent Note the occurrence of the name @{text mult_nat} in the
  primrec declaration; by default, the local name of a class operation
  @{text f} to be instantiated on type constructor @{text \<kappa>} is
  mangled as @{text f_\<kappa>}.  In case of uncertainty, these names may be
  inspected using the @{command "print_context"} command.
*}

subsection {* Lifting and parametric types *}

text {*
  Overloaded definitions given at a class instantiation may include
  recursion over the syntactic structure of types.  As a canonical
  example, we model product semigroups using our simple algebra:
*}

instantiation %quote prod :: (semigroup, semigroup) semigroup
begin

definition %quote
  mult_prod_def: "p\<^sub>1 \<otimes> p\<^sub>2 = (fst p\<^sub>1 \<otimes> fst p\<^sub>2, snd p\<^sub>1 \<otimes> snd p\<^sub>2)"

instance %quote proof
  fix p\<^sub>1 p\<^sub>2 p\<^sub>3 :: "\<alpha>\<Colon>semigroup \<times> \<beta>\<Colon>semigroup"
  show "p\<^sub>1 \<otimes> p\<^sub>2 \<otimes> p\<^sub>3 = p\<^sub>1 \<otimes> (p\<^sub>2 \<otimes> p\<^sub>3)"
    unfolding mult_prod_def by (simp add: assoc)
qed

end %quote

text {*
  \noindent Associativity of product semigroups is established using
  the definition of @{text "(\<otimes>)"} on products and the hypothetical
  associativity of the type components; these hypotheses are
  legitimate due to the @{class semigroup} constraints imposed on the
  type components by the @{command instance} proposition.  Indeed,
  this pattern often occurs with parametric types and type classes.
*}

subsection {* Subclassing *}

text {*
  We define a subclass @{text monoidl} (a semigroup with a left-hand
  neutral) by extending @{class semigroup} with one additional
  parameter @{text neutral} together with its characteristic property:
*}

class %quote monoidl = semigroup +
  fixes neutral :: "\<alpha>" ("\<one>")
  assumes neutl: "\<one> \<otimes> x = x"

text {*
  \noindent Again, we prove some instances, by providing suitable
  parameter definitions and proofs for the additional specifications.
  Observe that instantiations for types with the same arity may be
  simultaneous:
*}

instantiation %quote nat and int :: monoidl
begin

definition %quote
  neutral_nat_def: "\<one> = (0\<Colon>nat)"

definition %quote
  neutral_int_def: "\<one> = (0\<Colon>int)"

instance %quote proof
  fix n :: nat
  show "\<one> \<otimes> n = n"
    unfolding neutral_nat_def by simp
next
  fix k :: int
  show "\<one> \<otimes> k = k"
    unfolding neutral_int_def mult_int_def by simp
qed

end %quote

instantiation %quote prod :: (monoidl, monoidl) monoidl
begin

definition %quote
  neutral_prod_def: "\<one> = (\<one>, \<one>)"

instance %quote proof
  fix p :: "\<alpha>\<Colon>monoidl \<times> \<beta>\<Colon>monoidl"
  show "\<one> \<otimes> p = p"
    unfolding neutral_prod_def mult_prod_def by (simp add: neutl)
qed

end %quote

text {*
  \noindent Fully-fledged monoids are modelled by another subclass,
  which does not add new parameters but tightens the specification:
*}

class %quote monoid = monoidl +
  assumes neutr: "x \<otimes> \<one> = x"

instantiation %quote nat and int :: monoid
begin

instance %quote proof
  fix n :: nat
  show "n \<otimes> \<one> = n"
    unfolding neutral_nat_def by (induct n) simp_all
next
  fix k :: int
  show "k \<otimes> \<one> = k"
    unfolding neutral_int_def mult_int_def by simp
qed

end %quote

instantiation %quote prod :: (monoid, monoid) monoid
begin

instance %quote proof
  fix p :: "\<alpha>\<Colon>monoid \<times> \<beta>\<Colon>monoid"
  show "p \<otimes> \<one> = p"
    unfolding neutral_prod_def mult_prod_def by (simp add: neutr)
qed

end %quote

text {*
  \noindent To finish our small algebra example, we add a @{text
  group} class with a corresponding instance:
*}

class %quote group = monoidl +
  fixes inverse :: "\<alpha> \<Rightarrow> \<alpha>"    ("(_\<div>)" [1000] 999)
  assumes invl: "x\<div> \<otimes> x = \<one>"

instantiation %quote int :: group
begin

definition %quote
  inverse_int_def: "i\<div> = - (i\<Colon>int)"

instance %quote proof
  fix i :: int
  have "-i + i = 0" by simp
  then show "i\<div> \<otimes> i = \<one>"
    unfolding mult_int_def neutral_int_def inverse_int_def .
qed

end %quote

section {* Type classes as locales *}

subsection {* A look behind the scenes *}

text {*
  The example above gives an impression how Isar type classes work in
  practice.  As stated in the introduction, classes also provide a
  link to Isar's locale system.  Indeed, the logical core of a class
  is nothing other than a locale:
*}

class %quote idem =
  fixes f :: "\<alpha> \<Rightarrow> \<alpha>"
  assumes idem: "f (f x) = f x"

text {*
  \noindent essentially introduces the locale
*} (*<*)setup %invisible {* Sign.add_path "foo" *}
(*>*)
locale %quote idem =
  fixes f :: "\<alpha> \<Rightarrow> \<alpha>"
  assumes idem: "f (f x) = f x"

text {* \noindent together with corresponding constant(s): *}

consts %quote f :: "\<alpha> \<Rightarrow> \<alpha>"

text {*
  \noindent The connection to the type system is done by means of a
  primitive type class @{text "idem"}, together with a corresponding
  interpretation:
*}

interpretation %quote idem_class:
  idem "f \<Colon> (\<alpha>\<Colon>idem) \<Rightarrow> \<alpha>"
(*<*)sorry(*>*)

text {*
  \noindent This gives you the full power of the Isabelle module system;
  conclusions in locale @{text idem} are implicitly propagated
  to class @{text idem}.
*} (*<*)setup %invisible {* Sign.parent_path *}
(*>*)
subsection {* Abstract reasoning *}

text {*
  Isabelle locales enable reasoning at a general level, while results
  are implicitly transferred to all instances.  For example, we can
  now establish the @{text "left_cancel"} lemma for groups, which
  states that the function @{text "(x \<otimes>)"} is injective:
*}

lemma %quote (in group) left_cancel: "x \<otimes> y = x \<otimes> z \<longleftrightarrow> y = z"
proof
  assume "x \<otimes> y = x \<otimes> z"
  then have "x\<div> \<otimes> (x \<otimes> y) = x\<div> \<otimes> (x \<otimes> z)" by simp
  then have "(x\<div> \<otimes> x) \<otimes> y = (x\<div> \<otimes> x) \<otimes> z" using assoc by simp
  then show "y = z" using neutl and invl by simp
next
  assume "y = z"
  then show "x \<otimes> y = x \<otimes> z" by simp
qed

text {*
  \noindent Here the \qt{@{keyword "in"} @{class group}} target
  specification indicates that the result is recorded within that
  context for later use.  This local theorem is also lifted to the
  global one @{fact "group.left_cancel:"} @{prop [source] "\<And>x y z \<Colon>
  \<alpha>\<Colon>group. x \<otimes> y = x \<otimes> z \<longleftrightarrow> y = z"}.  Since type @{text "int"} has been
  made an instance of @{text "group"} before, we may refer to that
  fact as well: @{prop [source] "\<And>x y z \<Colon> int. x \<otimes> y = x \<otimes> z \<longleftrightarrow> y =
  z"}.
*}

subsection {* Derived definitions *}

text {*
  Isabelle locales are targets which support local definitions:
*}

primrec %quote (in monoid) pow_nat :: "nat \<Rightarrow> \<alpha> \<Rightarrow> \<alpha>" where
  "pow_nat 0 x = \<one>"
  | "pow_nat (Suc n) x = x \<otimes> pow_nat n x"

text {*
  \noindent If the locale @{text group} is also a class, this local
  definition is propagated onto a global definition of @{term [source]
  "pow_nat \<Colon> nat \<Rightarrow> \<alpha>\<Colon>monoid \<Rightarrow> \<alpha>\<Colon>monoid"} with corresponding theorems

  @{thm pow_nat.simps [no_vars]}.

  \noindent As you can see from this example, for local definitions
  you may use any specification tool which works together with
  locales, such as Krauss's recursive function package
  @{cite krauss2006}.
*}

subsection {* A functor analogy *}

text {*
  We introduced Isar classes by analogy to type classes in functional
  programming; if we reconsider this in the context of what has been
  said about type classes and locales, we can drive this analogy
  further by stating that type classes essentially correspond to
  functors that have a canonical interpretation as type classes.
  There is also the possibility of other interpretations.  For
  example, @{text list}s also form a monoid with @{text append} and
  @{term "[]"} as operations, but it seems inappropriate to apply to
  lists the same operations as for genuinely algebraic types.  In such
  a case, we can simply make a particular interpretation of monoids
  for lists:
*}

interpretation %quote list_monoid: monoid append "[]"
  proof qed auto

text {*
  \noindent This enables us to apply facts on monoids
  to lists, e.g. @{thm list_monoid.neutl [no_vars]}.

  When using this interpretation pattern, it may also
  be appropriate to map derived definitions accordingly:
*}

primrec %quote replicate :: "nat \<Rightarrow> \<alpha> list \<Rightarrow> \<alpha> list" where
  "replicate 0 _ = []"
  | "replicate (Suc n) xs = xs @ replicate n xs"

interpretation %quote list_monoid: monoid append "[]" where
  "monoid.pow_nat append [] = replicate"
proof -
  interpret monoid append "[]" ..
  show "monoid.pow_nat append [] = replicate"
  proof
    fix n
    show "monoid.pow_nat append [] n = replicate n"
      by (induct n) auto
  qed
qed intro_locales

text {*
  \noindent This pattern is also helpful to reuse abstract
  specifications on the \emph{same} type.  For example, think of a
  class @{text preorder}; for type @{typ nat}, there are at least two
  possible instances: the natural order or the order induced by the
  divides relation.  But only one of these instances can be used for
  @{command instantiation}; using the locale behind the class @{text
  preorder}, it is still possible to utilise the same abstract
  specification again using @{command interpretation}.
*}

subsection {* Additional subclass relations *}

text {*
  Any @{text "group"} is also a @{text "monoid"}; this can be made
  explicit by claiming an additional subclass relation, together with
  a proof of the logical difference:
*}

subclass %quote (in group) monoid
proof
  fix x
  from invl have "x\<div> \<otimes> x = \<one>" by simp
  with assoc [symmetric] neutl invl have "x\<div> \<otimes> (x \<otimes> \<one>) = x\<div> \<otimes> x" by simp
  with left_cancel show "x \<otimes> \<one> = x" by simp
qed

text {*
  The logical proof is carried out on the locale level.  Afterwards it
  is propagated to the type system, making @{text group} an instance
  of @{text monoid} by adding an additional edge to the graph of
  subclass relations (\figref{fig:subclass}).

  \begin{figure}[htbp]
   \begin{center}
     \small
     \unitlength 0.6mm
     \begin{picture}(40,60)(0,0)
       \put(20,60){\makebox(0,0){@{text semigroup}}}
       \put(20,40){\makebox(0,0){@{text monoidl}}}
       \put(00,20){\makebox(0,0){@{text monoid}}}
       \put(40,00){\makebox(0,0){@{text group}}}
       \put(20,55){\vector(0,-1){10}}
       \put(15,35){\vector(-1,-1){10}}
       \put(25,35){\vector(1,-3){10}}
     \end{picture}
     \hspace{8em}
     \begin{picture}(40,60)(0,0)
       \put(20,60){\makebox(0,0){@{text semigroup}}}
       \put(20,40){\makebox(0,0){@{text monoidl}}}
       \put(00,20){\makebox(0,0){@{text monoid}}}
       \put(40,00){\makebox(0,0){@{text group}}}
       \put(20,55){\vector(0,-1){10}}
       \put(15,35){\vector(-1,-1){10}}
       \put(05,15){\vector(3,-1){30}}
     \end{picture}
     \caption{Subclass relationship of monoids and groups:
        before and after establishing the relationship
        @{text "group \<subseteq> monoid"};  transitive edges are left out.}
     \label{fig:subclass}
   \end{center}
  \end{figure}

  For illustration, a derived definition in @{text group} using @{text
  pow_nat}
*}

definition %quote (in group) pow_int :: "int \<Rightarrow> \<alpha> \<Rightarrow> \<alpha>" where
  "pow_int k x = (if k >= 0
    then pow_nat (nat k) x
    else (pow_nat (nat (- k)) x)\<div>)"

text {*
  \noindent yields the global definition of @{term [source] "pow_int \<Colon>
  int \<Rightarrow> \<alpha>\<Colon>group \<Rightarrow> \<alpha>\<Colon>group"} with the corresponding theorem @{thm
  pow_int_def [no_vars]}.
*}

subsection {* A note on syntax *}

text {*
  As a convenience, class context syntax allows references to local
  class operations and their global counterparts uniformly; type
  inference resolves ambiguities.  For example:
*}

context %quote semigroup
begin

term %quote "x \<otimes> y" -- {* example 1 *}
term %quote "(x\<Colon>nat) \<otimes> y" -- {* example 2 *}

end  %quote

term %quote "x \<otimes> y" -- {* example 3 *}

text {*
  \noindent Here in example 1, the term refers to the local class
  operation @{text "mult [\<alpha>]"}, whereas in example 2 the type
  constraint enforces the global class operation @{text "mult [nat]"}.
  In the global context in example 3, the reference is to the
  polymorphic global class operation @{text "mult [?\<alpha> \<Colon> semigroup]"}.
*}

section {* Further issues *}

subsection {* Type classes and code generation *}

text {*
  Turning back to the first motivation for type classes, namely
  overloading, it is obvious that overloading stemming from @{command
  class} statements and @{command instantiation} targets naturally
  maps to Haskell type classes.  The code generator framework
  @{cite "isabelle-codegen"} takes this into account.  If the target
  language (e.g.~SML) lacks type classes, then they are implemented by
  an explicit dictionary construction.  As example, let's go back to
  the power function:
*}

definition %quote example :: int where
  "example = pow_int 10 (-2)"

text {*
  \noindent This maps to Haskell as follows:
*}
text %quotetypewriter {*
  @{code_stmts example (Haskell)}
*}

text {*
  \noindent The code in SML has explicit dictionary passing:
*}
text %quotetypewriter {*
  @{code_stmts example (SML)}
*}

text {*
  \noindent In Scala, implicts are used as dictionaries:
*}
text %quotetypewriter {*
  @{code_stmts example (Scala)}
*}

subsection {* Inspecting the type class universe *}

text {*
  To facilitate orientation in complex subclass structures, two
  diagnostics commands are provided:

  \begin{description}

    \item[@{command "print_classes"}] print a list of all classes
      together with associated operations etc.

    \item[@{command "class_deps"}] visualizes the subclass relation
      between all classes as a Hasse diagram.  An optional first sort argument
      constrains the set of classes to all subclasses of this sort,
      an optional second sort argument to all superclasses of this sort.

  \end{description}
*}

end


;;; -*- syntax: common-lisp; package: KEIM; base: 10; mode: Theory -*-
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;
;;                                                                          ;;
;;   Copyright (C) 1993 by AG Siekmann, Fachbereich Informatik,             ;;
;;   Universitaet des Saarlandes, Saarbruecken, Germany.                    ;;
;;   All rights reserved.                                                   ;;
;;   For information about this program, write to:                          ;;
;;     KEIM Project                                                         ;;
;;     AG Siekmann/FB Informatik                                            ;;
;;     Universitaet des Saarlandes                                          ;;
;;     Postfach 1150                                                        ;;
;;     D-66041 Saarbruecken                                                 ;;
;;     Germany                                                              ;;
;;   electronic mail: keim@cs.uni-sb.de                                     ;;
;;                                                                          ;;
;;   The author makes no representations about the suitability of this      ;;
;;   software for any purpose.  It is provided "AS IS" without express or   ;;
;;   implied warranty.  In particular, it must be understood that this      ;;
;;   software is an experimental version, and is not suitable for use in    ;;
;;   any safety-critical application, and the author denies a license for   ;;
;;   such use.                                                              ;;
;;                                                                          ;;
;;   You may use, copy, modify and distribute this software for any         ;;
;;   noncommercial and non-safety-critical purpose.  Use of this software   ;;
;;   in a commercial product is not included under this license.  You must  ;;
;;   maintain this copyright statement in all copies of this software that  ;;
;;   you modify or distribute.                                              ;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;
(in-package :omega)

(th~deftheorem plus-real-step2
	       (in real)
	       (conclusion
		(forall (lam (x num)
			     (forall (lam (y num)
					  (implies
					   (and (in x real) (in y real))
					   (= (plus x (s y)) (s (plus x y)))))))))
	       (help "The recursive definition of plus on the right term."))

(th~deftheorem plus-real-closed
	       (in real)
	       (conclusion (forall (lam (x num)
				     (forall (lam (y num)
						  (implies
						   (and (in x real) (in y real)) (in (plus x y) real))))))))

(th~deftheorem a-plus-real
	       (in real)
	       (conclusion (forall (lam (x num)
				     (forall (lam (y num)
						  (forall (lam (z num)
							       (implies
								(and (in x real) (and (in y real) (in z real)))
								(= (plus (plus x y) z) (plus x (plus y z))))))))))))

(th~deftheorem c-plus-real
	       (in real)
	       (conclusion (forall (lam (x num)
				     (forall (lam (y num)
						  (implies
						   (and (in x real) (in y real))
						   (= (plus x y) (plus y x)))))))))

(th~deftheorem 0-plus-real
	       (in real)
	       (conclusion (forall (lam (x num)
					(implies (in x real) (= (plus 0 x) x))))))

(th~deftheorem 1-times-real
	       (in real)
	       (conclusion (forall (lam (x num)
					(implies (in x real) (= (times 1 x) x))))))

(th~deftheorem 0-times-real
	       (in real)
	       (conclusion (forall (lam (x num)
					(implies (in x real) (= (times 0 x) 0))))))

(th~deftheorem a-times-real
	       (in real)
	       (conclusion (forall (lam (x num)
				     (forall (lam (y num)
						  (forall (lam (z num)
							       (implies
								(and (in x real) (and (in y real) (in z real)))
								(= (times (times x y) z) (times x (times y z))))))))))))

(th~deftheorem c-times-real
	       (in real)
	       (conclusion (forall (lam (x num)
				     (forall (lam (y num)
						  (implies
						   (and (in x real) (in y real))
						   (= (times x y) (times y x)))))))))

(th~deftheorem Dist-Right-real
	       (in real)
	       (conclusion (forall (lam (x num)
					(forall (lam (y num)
						     (forall (lam (z num)
								  (implies
								   (and (in x real) (and (in y real) (in z real)))
								   (= (times (plus x y) z)
								      (plus (times x z) (times y z))))))))))))

(th~deftheorem Dist-Left-real
	       (in real)
	       (conclusion (forall (lam (x num)
					(forall (lam (y num)
						     (forall (lam (z num)
								  (implies
								   (and (in x real) (and (in y real) (in z real)))
								   (= (times x (plus y z))
								      (plus (times x y) (times x z))))))))))))

(th~deftheorem minus2plus
	       (in real)
	       (conclusion (forall (lam (x num)
                                        (forall (lam (y num)
					             (implies
                                                      (and (in x real) (in y real))
                                                      (= (minus x y) (plus x (times -1 y))))))))))

(th~deftheorem sqrt2power
	       (in real)
	       (conclusion (forall (lam (x num)
                                        (implies
                                         (in x real)
                                         (= (sqrt x) (power x 1/2)))))))

(th~deftheorem div2times
	       (in real)
	       (conclusion (forall (lam (x num)
                                        (forall (lam (y num)
					             (implies
                                                      (and (in x real) (in y real))
                                                      (= (div x y) (times x (divide 1 y))))))))))

(th~deftheorem power-1-real
	       (in real)
	       (conclusion (forall (lam (x num)
					(implies (in x real) (= (power x 1) x))))))

(th~deftheorem 1-power-real
	       (in real)
	       (conclusion (forall (lam (x num)
					(implies (in x real) (= (power 1 x) 1))))))

(th~deftheorem 0-power-real
	       (in real)
	       (conclusion (forall (lam (x num)
					(implies (in x real) (= (power 0 x) 0))))))

(th~deftheorem power-0-real
	       (in real)
	       (conclusion (forall (lam (x num)
					(implies (in x real) (= (power x 0) 1))))))

(th~deftheorem times-power-real
	       (in real)
	       (conclusion (forall (lam (x num)
					(forall (lam (y num)
						     (forall (lam (z num)
								  (implies
								   (and (in x real) (and (in y real) (in z real)))
								   (= (power x (plus y z))
								      (times (power x y) (power x z))))))))))))

(th~deftheorem times-power-2-real
	       (in real)
	       (conclusion (forall (lam (x num)
					(forall (lam (y num)
						     (forall (lam (z num)
								  (implies
								   (and (in x real) (and (in y real) (in z real)))
								   (= (power (times x y) z)
								      (times (power x z) (power y z))))))))))))

(th~deftheorem power-power-real
	       (in real)
	       (conclusion (forall (lam (x num)
					(forall (lam (y num)
						     (forall (lam (z num)
								  (implies
								   (and (in x real) (and (in y real) (in z real)))
								   (= (power (power x y) z)
								      (power x (times y z))))))))))))

(th~deftheorem rat-criterion
	       (in rational)
	       (conclusion
		(forall-sort (lam (x num)
				  (exists-sort (lam (y num)
				  (exists-sort (lam (z num)
						    (and (= (times x y) z)
							 (not (exists-sort (lam (d num)
										 (common-divisor y z d))
									   int))))
								 int))int))rat))
	       (help "x rational implies there exist integers y,z which have no common divisor with x=y*z."))