theory ETCS_Wellordering
  imports ETCS_Axioms ETCS_Comparison
begin

lemma NOT_eq_pred_left_coproj:
  assumes u_type[type_rule]: "u \<in>\<^sub>c X \<Coprod> Y" and x_type[type_rule]: "x \<in>\<^sub>c X"
  shows "NOT \<circ>\<^sub>c eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>u, left_coproj X Y \<circ>\<^sub>c x\<rangle> = ((NOT \<circ>\<^sub>c  eq_pred X \<circ>\<^sub>c \<langle>id X, x \<circ>\<^sub>c \<beta>\<^bsub>X\<^esub>\<rangle>) \<amalg> (\<t> \<circ>\<^sub>c \<beta>\<^bsub>Y\<^esub>))  \<circ>\<^sub>c u"
proof-
  have "NOT \<circ>\<^sub>c eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>u, left_coproj X Y \<circ>\<^sub>c x\<rangle> = NOT \<circ>\<^sub>c (((eq_pred X \<circ>\<^sub>c \<langle>id X, x \<circ>\<^sub>c \<beta>\<^bsub>X\<^esub>\<rangle>) \<amalg> (\<f> \<circ>\<^sub>c \<beta>\<^bsub>Y\<^esub>)) \<circ>\<^sub>c u)"
    by (simp add: eq_pred_left_coproj u_type x_type)
  also have "... = ( (NOT \<circ>\<^sub>c(eq_pred X \<circ>\<^sub>c \<langle>id X, x \<circ>\<^sub>c \<beta>\<^bsub>X\<^esub>\<rangle>)) \<amalg>  (NOT \<circ>\<^sub>c(\<f> \<circ>\<^sub>c \<beta>\<^bsub>Y\<^esub>))) \<circ>\<^sub>c u"
    by (typecheck_cfuncs, smt (z3) cfunc_coprod_comp comp_associative2)
  also have "... = ((NOT \<circ>\<^sub>c  eq_pred X \<circ>\<^sub>c \<langle>id X, x \<circ>\<^sub>c \<beta>\<^bsub>X\<^esub>\<rangle>) \<amalg> (\<t> \<circ>\<^sub>c \<beta>\<^bsub>Y\<^esub>)  ) \<circ>\<^sub>c u"
    using NOT_false_is_true comp_associative2 by (typecheck_cfuncs, auto)
    then show ?thesis
    using calculation by auto
qed

lemma NOT_eq_pred_right_coproj:
  assumes u_type[type_rule]: "u \<in>\<^sub>c X \<Coprod> Y" and y_type[type_rule]: "y \<in>\<^sub>c Y"
  shows "NOT \<circ>\<^sub>c eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>u, right_coproj X Y \<circ>\<^sub>c y\<rangle> = ((\<t> \<circ>\<^sub>c \<beta>\<^bsub>X\<^esub>) \<amalg> (NOT \<circ>\<^sub>c  eq_pred Y \<circ>\<^sub>c \<langle>id Y, y \<circ>\<^sub>c \<beta>\<^bsub>Y\<^esub>\<rangle>)) \<circ>\<^sub>c u"
proof-
  have "NOT \<circ>\<^sub>c eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>u, right_coproj X Y \<circ>\<^sub>c y\<rangle> = NOT \<circ>\<^sub>c (((\<f> \<circ>\<^sub>c \<beta>\<^bsub>X\<^esub>) \<amalg> (eq_pred Y \<circ>\<^sub>c \<langle>id Y, y \<circ>\<^sub>c \<beta>\<^bsub>Y\<^esub>\<rangle>)) \<circ>\<^sub>c u)"
    by (simp add: eq_pred_right_coproj u_type y_type)
  also have "... = (( (NOT \<circ>\<^sub>c(\<f> \<circ>\<^sub>c \<beta>\<^bsub>X\<^esub>)) \<amalg> (NOT \<circ>\<^sub>c(eq_pred Y \<circ>\<^sub>c \<langle>id Y, y \<circ>\<^sub>c \<beta>\<^bsub>Y\<^esub>\<rangle>))) \<circ>\<^sub>c u)"
    by (typecheck_cfuncs, smt (z3) cfunc_coprod_comp comp_associative2)
  also have "... = ((\<t> \<circ>\<^sub>c \<beta>\<^bsub>X\<^esub>) \<amalg> (NOT \<circ>\<^sub>c  eq_pred Y \<circ>\<^sub>c \<langle>id Y, y \<circ>\<^sub>c \<beta>\<^bsub>Y\<^esub>\<rangle>)) \<circ>\<^sub>c u"
    by (typecheck_cfuncs, simp add: NOT_false_is_true comp_associative2)
  then show ?thesis
    using calculation by auto
qed

lemma eq_pred_func_pair:
  assumes f1_type[type_rule]: "f1: A \<rightarrow> X"
  assumes f2_type[type_rule]: "f2: A \<rightarrow> X"
  assumes g1_type[type_rule]: "g1: A \<rightarrow> Y"
  assumes g2_type[type_rule]: "g2: A \<rightarrow> Y"
  shows "eq_pred (X\<times>\<^sub>c Y) \<circ>\<^sub>c \<langle>\<langle>f1,g1\<rangle>, \<langle>f2, g2\<rangle>\<rangle> =
         AND \<circ>\<^sub>c \<langle>eq_pred X \<circ>\<^sub>c \<langle>f1,f2\<rangle>,  eq_pred Y \<circ>\<^sub>c \<langle>g1,g2\<rangle>\<rangle>"
proof(rule ccontr)
  assume "eq_pred (X \<times>\<^sub>c Y) \<circ>\<^sub>c \<langle>\<langle>f1,g1\<rangle>,\<langle>f2,g2\<rangle>\<rangle> \<noteq> AND \<circ>\<^sub>c \<langle>eq_pred X \<circ>\<^sub>c \<langle>f1,f2\<rangle>,eq_pred Y \<circ>\<^sub>c \<langle>g1,g2\<rangle>\<rangle>"
  then obtain a where a_type[type_rule]: "a \<in>\<^sub>c A" and a_def: "(eq_pred (X \<times>\<^sub>c Y) \<circ>\<^sub>c \<langle>\<langle>f1,g1\<rangle>,\<langle>f2,g2\<rangle>\<rangle>) \<circ>\<^sub>c a \<noteq> (AND \<circ>\<^sub>c \<langle>eq_pred X \<circ>\<^sub>c \<langle>f1,f2\<rangle>,eq_pred Y \<circ>\<^sub>c \<langle>g1,g2\<rangle>\<rangle>) \<circ>\<^sub>c a"
    by (typecheck_cfuncs, meson  one_separator)
  then show False
  proof (cases "(eq_pred (X \<times>\<^sub>c Y) \<circ>\<^sub>c \<langle>\<langle>f1,g1\<rangle>,\<langle>f2,g2\<rangle>\<rangle>) \<circ>\<^sub>c a = \<t>")
    assume a1: "(eq_pred (X \<times>\<^sub>c Y) \<circ>\<^sub>c \<langle>\<langle>f1,g1\<rangle>,\<langle>f2,g2\<rangle>\<rangle>) \<circ>\<^sub>c a = \<t>"
    then have "eq_pred (X \<times>\<^sub>c Y) \<circ>\<^sub>c \<langle>\<langle>f1,g1\<rangle>,\<langle>f2,g2\<rangle>\<rangle> \<circ>\<^sub>c a  = \<t>"
      by (typecheck_cfuncs, simp add: a1 comp_associative2)
    then have "eq_pred (X \<times>\<^sub>c Y) \<circ>\<^sub>c \<langle>\<langle>f1,g1\<rangle> \<circ>\<^sub>c a ,\<langle>f2,g2\<rangle> \<circ>\<^sub>c a\<rangle>   = \<t>"
      using  cfunc_prod_comp by (typecheck_cfuncs, force)
    then have "\<langle>f1,g1\<rangle> \<circ>\<^sub>c a =  \<langle>f2, g2\<rangle> \<circ>\<^sub>c a"
      by (typecheck_cfuncs, meson comp_type eq_pred_iff_eq)
    then have "\<langle>f1 \<circ>\<^sub>c a,g1 \<circ>\<^sub>c a\<rangle>  =  \<langle>f2 \<circ>\<^sub>c a , g2\<circ>\<^sub>c a \<rangle>"
      using  cfunc_prod_comp by (typecheck_cfuncs, force)
    then have contradiction: "(f1 \<circ>\<^sub>c a = f2 \<circ>\<^sub>c a) \<and> (g1 \<circ>\<^sub>c a = g2 \<circ>\<^sub>c a)"
      using cart_prod_eq2 by (typecheck_cfuncs, auto)
    have "(AND \<circ>\<^sub>c \<langle>eq_pred X \<circ>\<^sub>c \<langle>f1,f2\<rangle>,eq_pred Y \<circ>\<^sub>c \<langle>g1,g2\<rangle>\<rangle>) \<circ>\<^sub>c a = \<f>"
      using a_def a1  by (typecheck_cfuncs, metis  true_false_only_truth_values)
    then have "AND \<circ>\<^sub>c \<langle>eq_pred X \<circ>\<^sub>c \<langle>f1,f2\<rangle>,eq_pred Y \<circ>\<^sub>c \<langle>g1,g2\<rangle>\<rangle> \<circ>\<^sub>c a = \<f>"
      by (typecheck_cfuncs, simp add:  comp_associative2)
    then have "AND \<circ>\<^sub>c \<langle>(eq_pred X \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<circ>\<^sub>c a, (eq_pred Y \<circ>\<^sub>c \<langle>g1,g2\<rangle>) \<circ>\<^sub>c a\<rangle>  = \<f>"
      using  cfunc_prod_comp by (typecheck_cfuncs, force)
    then have "(((eq_pred X \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<circ>\<^sub>c a) = \<f>) \<or> (((eq_pred Y \<circ>\<^sub>c \<langle>g1,g2\<rangle>) \<circ>\<^sub>c a) = \<f>)"
      by (typecheck_cfuncs, metis AND_true_true_is_true  true_false_only_truth_values)
    then have "((eq_pred X \<circ>\<^sub>c \<langle>f1,f2\<rangle> \<circ>\<^sub>c a) = \<f>) \<or> ((eq_pred Y \<circ>\<^sub>c \<langle>g1,g2\<rangle> \<circ>\<^sub>c a) = \<f>)"
      by (typecheck_cfuncs, simp add:  comp_associative2)
    then have "((eq_pred X \<circ>\<^sub>c \<langle>f1 \<circ>\<^sub>c a,f2 \<circ>\<^sub>c a\<rangle>) = \<f>) \<or> ((eq_pred Y \<circ>\<^sub>c \<langle>g1 \<circ>\<^sub>c a, g2 \<circ>\<^sub>c a\<rangle>) = \<f>)"
      using  cfunc_prod_comp by (typecheck_cfuncs, force)
    then have "(f1 \<circ>\<^sub>c a \<noteq> f2 \<circ>\<^sub>c a) \<or> (g1 \<circ>\<^sub>c a \<noteq> g2 \<circ>\<^sub>c a)"
      using  eq_pred_iff_eq_conv by (typecheck_cfuncs, blast)
    then show False
      by (simp add: contradiction)
  next
    assume "(eq_pred (X \<times>\<^sub>c Y) \<circ>\<^sub>c \<langle>\<langle>f1,g1\<rangle>,\<langle>f2,g2\<rangle>\<rangle>) \<circ>\<^sub>c a \<noteq> \<t>"
    then have a1: "(eq_pred (X \<times>\<^sub>c Y) \<circ>\<^sub>c \<langle>\<langle>f1,g1\<rangle>,\<langle>f2,g2\<rangle>\<rangle>) \<circ>\<^sub>c a = \<f>"
      using true_false_only_truth_values by (typecheck_cfuncs, blast)
    then have "eq_pred (X \<times>\<^sub>c Y) \<circ>\<^sub>c \<langle>\<langle>f1,g1\<rangle>,\<langle>f2,g2\<rangle>\<rangle> \<circ>\<^sub>c a = \<f>"
      by (typecheck_cfuncs, simp add: a1 comp_associative2)
    then have "eq_pred (X \<times>\<^sub>c Y) \<circ>\<^sub>c \<langle>\<langle>f1,g1\<rangle> \<circ>\<^sub>c a ,\<langle>f2,g2\<rangle> \<circ>\<^sub>c a\<rangle>   = \<f>"
      using  cfunc_prod_comp by (typecheck_cfuncs, force)
    then have "\<langle>f1,g1\<rangle> \<circ>\<^sub>c a \<noteq>  \<langle>f2, g2\<rangle> \<circ>\<^sub>c a"
      using  eq_pred_iff_eq_conv by (typecheck_cfuncs, presburger)
    then have "\<langle>f1 \<circ>\<^sub>c a,g1 \<circ>\<^sub>c a\<rangle>  \<noteq>  \<langle>f2 \<circ>\<^sub>c a , g2\<circ>\<^sub>c a \<rangle>"
      using  cfunc_prod_comp by (typecheck_cfuncs, force)
    then have contradiction: "(f1 \<circ>\<^sub>c a \<noteq> f2 \<circ>\<^sub>c a) \<or> (g1 \<circ>\<^sub>c a \<noteq> g2 \<circ>\<^sub>c a)"
      using cart_prod_eq2 by (typecheck_cfuncs, auto)
    have "(AND \<circ>\<^sub>c \<langle>eq_pred X \<circ>\<^sub>c \<langle>f1,f2\<rangle>,eq_pred Y \<circ>\<^sub>c \<langle>g1,g2\<rangle>\<rangle>) \<circ>\<^sub>c a = \<t>"
      by (typecheck_cfuncs, metis  a1 a_def true_false_only_truth_values)
    then have "AND \<circ>\<^sub>c \<langle>eq_pred X \<circ>\<^sub>c \<langle>f1,f2\<rangle>,eq_pred Y \<circ>\<^sub>c \<langle>g1,g2\<rangle>\<rangle> \<circ>\<^sub>c a = \<t>"
      by (typecheck_cfuncs, simp add:  comp_associative2)
    then have "AND \<circ>\<^sub>c \<langle>(eq_pred X \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<circ>\<^sub>c a, (eq_pred Y \<circ>\<^sub>c \<langle>g1,g2\<rangle>) \<circ>\<^sub>c a\<rangle>  = \<t>"
      using  cfunc_prod_comp by (typecheck_cfuncs, force)
    then have "(((eq_pred X \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<circ>\<^sub>c a) = \<t>) \<and> (((eq_pred Y \<circ>\<^sub>c \<langle>g1,g2\<rangle>) \<circ>\<^sub>c a) = \<t>)"
      by (typecheck_cfuncs, metis AND_false_left_is_false AND_false_right_is_false  true_false_only_truth_values)
    then have "((eq_pred X \<circ>\<^sub>c \<langle>f1,f2\<rangle> \<circ>\<^sub>c a) = \<t>) \<and> ((eq_pred Y \<circ>\<^sub>c \<langle>g1,g2\<rangle> \<circ>\<^sub>c a) = \<t>)"
      by (typecheck_cfuncs, simp add:  comp_associative2)
    then have "((eq_pred X \<circ>\<^sub>c \<langle>f1 \<circ>\<^sub>c a,f2 \<circ>\<^sub>c a\<rangle>) = \<t>) \<and> ((eq_pred Y \<circ>\<^sub>c \<langle>g1 \<circ>\<^sub>c a, g2 \<circ>\<^sub>c a\<rangle>) = \<t>)"
      using  cfunc_prod_comp by (typecheck_cfuncs, force)
    then have "(f1 \<circ>\<^sub>c a = f2 \<circ>\<^sub>c a) \<and> (g1 \<circ>\<^sub>c a = g2 \<circ>\<^sub>c a)"
      using  eq_pred_iff_eq by (typecheck_cfuncs, blast)
    then show False
      using contradiction by blast
  qed
qed

lemma eq_pred_func_copair:
  assumes f1_type[type_rule]: "f1: X \<rightarrow> Z"
  assumes f2_type[type_rule]: "f2: X \<rightarrow> Z"
  assumes g1_type[type_rule]: "g1: Y \<rightarrow> Z"
  assumes g2_type[type_rule]: "g2: Y \<rightarrow> Z"
  shows "eq_pred Z \<circ>\<^sub>c \<langle>(f1\<amalg>g1), (f2\<amalg>g2)\<rangle> =
        (eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>)\<amalg>(eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>)"
proof(rule ccontr)
  assume "eq_pred Z \<circ>\<^sub>c \<langle>f1 \<amalg> g1,f2 \<amalg> g2\<rangle> \<noteq> (eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<amalg> (eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>)"
  then obtain xy where xy_type[type_rule]: "xy \<in>\<^sub>c X \<Coprod> Y" and xy_def: "(eq_pred Z \<circ>\<^sub>c \<langle>f1 \<amalg> g1,f2 \<amalg> g2\<rangle>) \<circ>\<^sub>c xy \<noteq> ((eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<amalg> (eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>)) \<circ>\<^sub>c xy"
    using  one_separator by (typecheck_cfuncs, blast)
  show False
  proof(cases "\<exists> x. x \<in>\<^sub>c X \<and> xy = left_coproj X Y \<circ>\<^sub>c x")
    assume "\<exists>x. x \<in>\<^sub>c X \<and> xy = left_coproj X Y \<circ>\<^sub>c x"
    then obtain x where x_type[type_rule]: "x \<in>\<^sub>c X" and x_def: "xy = left_coproj X Y \<circ>\<^sub>c x"
      by blast
    show False
    proof(cases "(eq_pred Z \<circ>\<^sub>c \<langle>f1 \<amalg> g1,f2 \<amalg> g2\<rangle>) \<circ>\<^sub>c xy = \<t>")
      assume LHS_true: "(eq_pred Z \<circ>\<^sub>c \<langle>f1 \<amalg> g1,f2 \<amalg> g2\<rangle>) \<circ>\<^sub>c xy = \<t>"

      then have "eq_pred Z \<circ>\<^sub>c \<langle>f1 \<amalg> g1,f2 \<amalg> g2\<rangle> \<circ>\<^sub>c xy = \<t>"
        using  comp_associative2 by (typecheck_cfuncs, force)
      then have "(eq_pred Z \<circ>\<^sub>c \<langle>(f1 \<amalg> g1),(f2 \<amalg> g2)\<rangle> \<circ>\<^sub>c (left_coproj X Y \<circ>\<^sub>c x))  = \<t>"
        using LHS_true x_def by blast
      then have "(eq_pred Z \<circ>\<^sub>c \<langle>(f1 \<amalg> g1)\<circ>\<^sub>c (left_coproj X Y \<circ>\<^sub>c x) ,(f2 \<amalg> g2) \<circ>\<^sub>c (left_coproj X Y \<circ>\<^sub>c x)\<rangle> )  = \<t>"
        using cfunc_prod_comp by (typecheck_cfuncs, auto)
      then have "(eq_pred Z \<circ>\<^sub>c \<langle>((f1 \<amalg> g1)\<circ>\<^sub>c left_coproj X Y) \<circ>\<^sub>c x ,((f2 \<amalg> g2) \<circ>\<^sub>c left_coproj X Y) \<circ>\<^sub>c x\<rangle> )  = \<t>"
        using  comp_associative2 by (typecheck_cfuncs, force)
      then have contradiction: "eq_pred Z \<circ>\<^sub>c \<langle>f1 \<circ>\<^sub>c x ,f2 \<circ>\<^sub>c x\<rangle>  = \<t>"
        by (typecheck_cfuncs, metis  g1_type g2_type left_coproj_cfunc_coprod)
      have "((eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<amalg> (eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>)) \<circ>\<^sub>c xy = \<f>"
        by (typecheck_cfuncs, metis LHS_true true_false_only_truth_values xy_def)
      then have f0: "(((eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<amalg> (eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>)) \<circ>\<^sub>c left_coproj X Y) \<circ>\<^sub>c x = \<f>"
        using  comp_associative2 x_def by (typecheck_cfuncs, auto)
      have "((eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<amalg> (eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>)) \<circ>\<^sub>c left_coproj X Y = eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>"
        using left_coproj_cfunc_coprod by (typecheck_cfuncs, presburger)
      then have "(eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<circ>\<^sub>c x = \<f>"
        using f0 by presburger
      then have "eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle> \<circ>\<^sub>c x = \<f>"
        by (typecheck_cfuncs, simp add:  comp_associative2)
      then have "eq_pred Z \<circ>\<^sub>c \<langle>f1 \<circ>\<^sub>c x,f2  \<circ>\<^sub>c x\<rangle> = \<f>"
        using  cfunc_prod_comp by (typecheck_cfuncs, force)
      then show False
        using contradiction true_false_distinct by auto
    next
      assume "(eq_pred Z \<circ>\<^sub>c \<langle>f1 \<amalg> g1,f2 \<amalg> g2\<rangle>) \<circ>\<^sub>c xy \<noteq> \<t>"
      then have LHS_false: "(eq_pred Z \<circ>\<^sub>c \<langle>f1 \<amalg> g1,f2 \<amalg> g2\<rangle>) \<circ>\<^sub>c xy = \<f>"
        using  true_false_only_truth_values by (typecheck_cfuncs, blast)
      then have "eq_pred Z \<circ>\<^sub>c \<langle>f1 \<amalg> g1,f2 \<amalg> g2\<rangle> \<circ>\<^sub>c xy = \<f>"
        using  comp_associative2 by (typecheck_cfuncs, force)
      then have "(eq_pred Z \<circ>\<^sub>c \<langle>(f1 \<amalg> g1),(f2 \<amalg> g2)\<rangle> \<circ>\<^sub>c (left_coproj X Y \<circ>\<^sub>c x))  = \<f>"
        using LHS_false x_def by blast
      then have "(eq_pred Z \<circ>\<^sub>c \<langle>(f1 \<amalg> g1)\<circ>\<^sub>c (left_coproj X Y \<circ>\<^sub>c x) ,(f2 \<amalg> g2) \<circ>\<^sub>c (left_coproj X Y \<circ>\<^sub>c x)\<rangle> )  = \<f>"
        using cfunc_prod_comp by (typecheck_cfuncs, auto)
      then have "(eq_pred Z \<circ>\<^sub>c \<langle>((f1 \<amalg> g1)\<circ>\<^sub>c left_coproj X Y) \<circ>\<^sub>c x ,((f2 \<amalg> g2) \<circ>\<^sub>c left_coproj X Y) \<circ>\<^sub>c x\<rangle> )  = \<f>"
        using  comp_associative2 by (typecheck_cfuncs, force)
      then have contradiction: "eq_pred Z \<circ>\<^sub>c \<langle>f1 \<circ>\<^sub>c x ,f2 \<circ>\<^sub>c x\<rangle>   = \<f>"
        by (typecheck_cfuncs, metis  g1_type g2_type left_coproj_cfunc_coprod)
      have "((eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<amalg> (eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>)) \<circ>\<^sub>c xy = \<t>"
        by (typecheck_cfuncs, metis LHS_false true_false_only_truth_values xy_def)
      then have f0: "(((eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<amalg> (eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>)) \<circ>\<^sub>c left_coproj X Y) \<circ>\<^sub>c x = \<t>"
        using  comp_associative2 x_def by (typecheck_cfuncs, auto)
      have "((eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<amalg> (eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>)) \<circ>\<^sub>c left_coproj X Y = eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>"
        using left_coproj_cfunc_coprod by (typecheck_cfuncs, presburger)
      then have "(eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<circ>\<^sub>c x = \<t>"
        using f0 by presburger
      then have "eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle> \<circ>\<^sub>c x = \<t>"
        by (typecheck_cfuncs, simp add:  comp_associative2)
      then have "eq_pred Z \<circ>\<^sub>c \<langle>f1 \<circ>\<^sub>c x,f2  \<circ>\<^sub>c x\<rangle> = \<t>"
        using  cfunc_prod_comp by (typecheck_cfuncs, force)
      then show False
        using contradiction true_false_distinct by auto
    qed
  next
    assume "\<nexists>x. x \<in>\<^sub>c X \<and> xy = left_coproj X Y \<circ>\<^sub>c x"
    then obtain y where y_type[type_rule]: "y \<in>\<^sub>c Y" and y_def: " xy = right_coproj X Y \<circ>\<^sub>c y"
      using  coprojs_jointly_surj by (typecheck_cfuncs, blast)
    show False
    proof(cases "(eq_pred Z \<circ>\<^sub>c \<langle>f1 \<amalg> g1,f2 \<amalg> g2\<rangle>) \<circ>\<^sub>c xy = \<t>")
      assume LHS_true: "(eq_pred Z \<circ>\<^sub>c \<langle>f1 \<amalg> g1,f2 \<amalg> g2\<rangle>) \<circ>\<^sub>c xy = \<t>"

      then have "eq_pred Z \<circ>\<^sub>c \<langle>f1 \<amalg> g1,f2 \<amalg> g2\<rangle> \<circ>\<^sub>c xy = \<t>"
        using  comp_associative2 by (typecheck_cfuncs, force)
      then have "(eq_pred Z \<circ>\<^sub>c \<langle>(f1 \<amalg> g1),(f2 \<amalg> g2)\<rangle> \<circ>\<^sub>c (right_coproj X Y \<circ>\<^sub>c y))  = \<t>"
        using LHS_true y_def by blast
      then have "(eq_pred Z \<circ>\<^sub>c \<langle>(f1 \<amalg> g1)\<circ>\<^sub>c (right_coproj X Y \<circ>\<^sub>c y) ,(f2 \<amalg> g2) \<circ>\<^sub>c (right_coproj X Y \<circ>\<^sub>c y)\<rangle> )  = \<t>"
        using cfunc_prod_comp by (typecheck_cfuncs, auto)
      then have "(eq_pred Z \<circ>\<^sub>c \<langle>((f1 \<amalg> g1)\<circ>\<^sub>c right_coproj X Y) \<circ>\<^sub>c y ,((f2 \<amalg> g2) \<circ>\<^sub>c right_coproj X Y) \<circ>\<^sub>c y\<rangle> )  = \<t>"
        using  comp_associative2 by (typecheck_cfuncs, force)
      then have contradiction: "eq_pred Z \<circ>\<^sub>c \<langle>g1 \<circ>\<^sub>c y ,g2 \<circ>\<^sub>c y\<rangle>  = \<t>"
        by (typecheck_cfuncs, metis  f1_type f2_type right_coproj_cfunc_coprod)
      have "((eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<amalg> (eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>)) \<circ>\<^sub>c xy = \<f>"
        by (typecheck_cfuncs, metis LHS_true true_false_only_truth_values xy_def)
      then have f0: "(((eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<amalg> (eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>)) \<circ>\<^sub>c right_coproj X Y) \<circ>\<^sub>c y = \<f>"
        using  comp_associative2 y_def by (typecheck_cfuncs, auto)
      have "((eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<amalg> (eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>)) \<circ>\<^sub>c right_coproj X Y = eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>"
        using right_coproj_cfunc_coprod by (typecheck_cfuncs, presburger)
      then have "(eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>) \<circ>\<^sub>c y = \<f>"
        using f0 by presburger
      then have "eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle> \<circ>\<^sub>cy = \<f>"
        by (typecheck_cfuncs, simp add:  comp_associative2)
      then have "eq_pred Z \<circ>\<^sub>c \<langle>g1 \<circ>\<^sub>c y,g2  \<circ>\<^sub>c y\<rangle> = \<f>"
        using  cfunc_prod_comp by (typecheck_cfuncs, force)
      then show False
        using contradiction true_false_distinct by auto
    next
      assume "(eq_pred Z \<circ>\<^sub>c \<langle>f1 \<amalg> g1,f2 \<amalg> g2\<rangle>) \<circ>\<^sub>c xy \<noteq> \<t>"
      then have LHS_false: "(eq_pred Z \<circ>\<^sub>c \<langle>f1 \<amalg> g1,f2 \<amalg> g2\<rangle>) \<circ>\<^sub>c xy = \<f>"
        using  true_false_only_truth_values by (typecheck_cfuncs, blast)
      then have "eq_pred Z \<circ>\<^sub>c \<langle>f1 \<amalg> g1,f2 \<amalg> g2\<rangle> \<circ>\<^sub>c xy = \<f>"
        using  comp_associative2 by (typecheck_cfuncs, force)
      then have "(eq_pred Z \<circ>\<^sub>c \<langle>(f1 \<amalg> g1),(f2 \<amalg> g2)\<rangle> \<circ>\<^sub>c (right_coproj X Y \<circ>\<^sub>c y))  = \<f>"
        using LHS_false y_def by blast
      then have "(eq_pred Z \<circ>\<^sub>c \<langle>(f1 \<amalg> g1)\<circ>\<^sub>c (right_coproj X Y \<circ>\<^sub>c y) ,(f2 \<amalg> g2) \<circ>\<^sub>c (right_coproj X Y \<circ>\<^sub>c y)\<rangle> )  = \<f>"
        using cfunc_prod_comp by (typecheck_cfuncs, auto)
      then have "(eq_pred Z \<circ>\<^sub>c \<langle>((f1 \<amalg> g1)\<circ>\<^sub>c right_coproj X Y) \<circ>\<^sub>c y ,((f2 \<amalg> g2) \<circ>\<^sub>c right_coproj X Y) \<circ>\<^sub>c y\<rangle> )  = \<f>"
        using  comp_associative2 by (typecheck_cfuncs, force)
      then have contradiction: "eq_pred Z \<circ>\<^sub>c \<langle>g1 \<circ>\<^sub>c y ,g2 \<circ>\<^sub>c y\<rangle>   = \<f>"
        by (typecheck_cfuncs, metis  f1_type f2_type right_coproj_cfunc_coprod)
      have "((eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<amalg> (eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>)) \<circ>\<^sub>c xy = \<t>"
        by (typecheck_cfuncs, metis LHS_false true_false_only_truth_values xy_def)
      then have f0: "(((eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<amalg> (eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>)) \<circ>\<^sub>c right_coproj X Y) \<circ>\<^sub>c y = \<t>"
        using  comp_associative2 y_def by (typecheck_cfuncs, auto)
      have "((eq_pred Z \<circ>\<^sub>c \<langle>f1,f2\<rangle>) \<amalg> (eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>)) \<circ>\<^sub>c right_coproj X Y = eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>"
        using right_coproj_cfunc_coprod by (typecheck_cfuncs, presburger)
      then have "(eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle>) \<circ>\<^sub>c y = \<t>"
        using f0 by presburger
      then have "eq_pred Z \<circ>\<^sub>c \<langle>g1,g2\<rangle> \<circ>\<^sub>c y = \<t>"
        by (typecheck_cfuncs, simp add:  comp_associative2)
      then have "eq_pred Z \<circ>\<^sub>c \<langle>g1 \<circ>\<^sub>c y, g2  \<circ>\<^sub>c y\<rangle> = \<t>"
        using  cfunc_prod_comp by (typecheck_cfuncs, force)
      then show False
        using contradiction true_false_distinct by auto
    qed
  qed
qed

lemma eq_pred_left_coproj2:
  assumes a_type[type_rule]: "f : A \<rightarrow> X" and b_type[type_rule]: "g : A \<rightarrow> X"
  shows "eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>left_coproj X Y \<circ>\<^sub>c f, left_coproj X Y \<circ>\<^sub>c g\<rangle> = eq_pred X \<circ>\<^sub>c \<langle>f, g\<rangle>"
proof(rule one_separator[where X = A, where Y = \<Omega>])
  show "eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>left_coproj X Y \<circ>\<^sub>c f,left_coproj X Y \<circ>\<^sub>c g\<rangle> : A \<rightarrow> \<Omega>"
    by typecheck_cfuncs
  show "eq_pred X \<circ>\<^sub>c \<langle>f,g\<rangle> : A \<rightarrow> \<Omega>"
    by typecheck_cfuncs
  show "\<And>a. a \<in>\<^sub>c A \<Longrightarrow> (eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>left_coproj X Y \<circ>\<^sub>c f,left_coproj X Y \<circ>\<^sub>c g\<rangle>) \<circ>\<^sub>c a = (eq_pred X \<circ>\<^sub>c \<langle>f,g\<rangle>) \<circ>\<^sub>c a"
  proof -
    fix a
    assume a_type[type_rule]: "a \<in>\<^sub>c A"
    have "(eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>left_coproj X Y \<circ>\<^sub>c f,left_coproj X Y \<circ>\<^sub>c g\<rangle>) \<circ>\<^sub>c a =
           eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>left_coproj X Y \<circ>\<^sub>c f,left_coproj X Y \<circ>\<^sub>c g\<rangle>  \<circ>\<^sub>c a"
      using comp_associative2 by (typecheck_cfuncs, force)
    also have "... = eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>left_coproj X Y \<circ>\<^sub>c f \<circ>\<^sub>c a,left_coproj X Y \<circ>\<^sub>c g \<circ>\<^sub>c a\<rangle>"
      by (typecheck_cfuncs, simp add: cfunc_prod_comp comp_associative2)
    also have "... = (eq_pred X \<circ>\<^sub>c \<langle>f,g\<rangle>) \<circ>\<^sub>c a"
    proof(cases "f \<circ>\<^sub>c a = g \<circ>\<^sub>c a")
      show "f \<circ>\<^sub>c a = g \<circ>\<^sub>c a \<Longrightarrow> eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>left_coproj X Y \<circ>\<^sub>c f \<circ>\<^sub>c a,left_coproj X Y \<circ>\<^sub>c g \<circ>\<^sub>c a\<rangle> = (eq_pred X \<circ>\<^sub>c \<langle>f,g\<rangle>) \<circ>\<^sub>c a"
        by (typecheck_cfuncs, smt (z3)  cfunc_prod_comp comp_associative2 eq_pred_iff_eq)
      show "f \<circ>\<^sub>c a \<noteq> g \<circ>\<^sub>c a \<Longrightarrow> eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>left_coproj X Y \<circ>\<^sub>c f \<circ>\<^sub>c a,left_coproj X Y \<circ>\<^sub>c g \<circ>\<^sub>c a\<rangle> = (eq_pred X \<circ>\<^sub>c \<langle>f,g\<rangle>) \<circ>\<^sub>c a"
        by (typecheck_cfuncs, smt (verit, best) cfunc_prod_comp comp_associative2 eq_pred_iff_eq_conv monomorphism_def3 left_coproj_are_monomorphisms)
    qed
    then show "(eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>left_coproj X Y \<circ>\<^sub>c f,left_coproj X Y \<circ>\<^sub>c g\<rangle>) \<circ>\<^sub>c a = (eq_pred X \<circ>\<^sub>c \<langle>f,g\<rangle>) \<circ>\<^sub>c a"
      using calculation by auto
  qed
qed

lemma eq_pred_right_coproj2:
  assumes a_type[type_rule]: "f : A \<rightarrow> Y" and b_type[type_rule]: "g : A \<rightarrow> Y"
  shows "eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>right_coproj X Y \<circ>\<^sub>c f, right_coproj X Y \<circ>\<^sub>c g\<rangle> = eq_pred Y \<circ>\<^sub>c \<langle>f, g\<rangle>"
proof(rule one_separator[where X = A, where Y = \<Omega>])
  show "eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>right_coproj X Y \<circ>\<^sub>c f,right_coproj X Y \<circ>\<^sub>c g\<rangle> : A \<rightarrow> \<Omega>"
    by typecheck_cfuncs
  show "eq_pred Y \<circ>\<^sub>c \<langle>f,g\<rangle> : A \<rightarrow> \<Omega>"
    by typecheck_cfuncs
  show "\<And>a. a \<in>\<^sub>c A \<Longrightarrow> (eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>right_coproj X Y \<circ>\<^sub>c f,right_coproj X Y \<circ>\<^sub>c g\<rangle>) \<circ>\<^sub>c a = (eq_pred Y \<circ>\<^sub>c \<langle>f,g\<rangle>) \<circ>\<^sub>c a"
  proof -
    fix a
    assume a_type[type_rule]: "a \<in>\<^sub>c A"
    have "(eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>right_coproj X Y \<circ>\<^sub>c f,right_coproj X Y \<circ>\<^sub>c g\<rangle>) \<circ>\<^sub>c a =
           eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>right_coproj X Y \<circ>\<^sub>c f,right_coproj X Y \<circ>\<^sub>c g\<rangle>  \<circ>\<^sub>c a"
      using comp_associative2 by (typecheck_cfuncs, force)
    also have "... = eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>right_coproj X Y \<circ>\<^sub>c f \<circ>\<^sub>c a,right_coproj X Y \<circ>\<^sub>c g \<circ>\<^sub>c a\<rangle>"
      by (typecheck_cfuncs, simp add: cfunc_prod_comp comp_associative2)
    also have "... = (eq_pred Y \<circ>\<^sub>c \<langle>f,g\<rangle>) \<circ>\<^sub>c a"
    proof(cases "f \<circ>\<^sub>c a = g \<circ>\<^sub>c a")
      show "f \<circ>\<^sub>c a = g \<circ>\<^sub>c a \<Longrightarrow> eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>right_coproj X Y \<circ>\<^sub>c f \<circ>\<^sub>c a,right_coproj X Y \<circ>\<^sub>c g \<circ>\<^sub>c a\<rangle> = (eq_pred Y \<circ>\<^sub>c \<langle>f,g\<rangle>) \<circ>\<^sub>c a"
        by (typecheck_cfuncs, smt (z3)  cfunc_prod_comp comp_associative2 eq_pred_iff_eq)
      show "f \<circ>\<^sub>c a \<noteq> g \<circ>\<^sub>c a \<Longrightarrow> eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>right_coproj X Y \<circ>\<^sub>c f \<circ>\<^sub>c a,right_coproj X Y \<circ>\<^sub>c g \<circ>\<^sub>c a\<rangle> = (eq_pred Y \<circ>\<^sub>c \<langle>f,g\<rangle>) \<circ>\<^sub>c a"
        by (typecheck_cfuncs, smt (verit, best) cfunc_prod_comp comp_associative2 eq_pred_iff_eq_conv monomorphism_def3 right_coproj_are_monomorphisms)
    qed
    then show "(eq_pred (X \<Coprod> Y) \<circ>\<^sub>c \<langle>right_coproj X Y \<circ>\<^sub>c f,right_coproj X Y \<circ>\<^sub>c g\<rangle>) \<circ>\<^sub>c a = (eq_pred Y \<circ>\<^sub>c \<langle>f,g\<rangle>) \<circ>\<^sub>c a"
      using calculation by auto
  qed
qed

theorem well_ordering_principle:
  assumes "nonempty A" "(A, m) \<subseteq>\<^sub>c \<nat>\<^sub>c"
  shows "\<exists> a. a \<in>\<^bsub>\<nat>\<^sub>c\<^esub> (A, m) \<and> (\<forall> b. b \<in>\<^bsub>\<nat>\<^sub>c\<^esub> (A, m) \<longrightarrow>  a \<le>\<^sub>\<nat> b)"
proof(cases "zero \<in>\<^bsub>\<nat>\<^sub>c\<^esub> (A, m)")
  show "zero \<in>\<^bsub>\<nat>\<^sub>c\<^esub> (A, m) \<Longrightarrow> \<exists>a. a \<in>\<^bsub>\<nat>\<^sub>c\<^esub> (A, m) \<and> (\<forall>b. b \<in>\<^bsub>\<nat>\<^sub>c\<^esub> (A, m) \<longrightarrow> a \<le>\<^sub>\<nat> b)"
    unfolding leq_infix_def using relative_member_def zero_is_smallest by blast
next
  assume no_zero: " \<not> zero \<in>\<^bsub>\<nat>\<^sub>c\<^esub> (A, m)"
  obtain \<chi>\<^sub>A where \<chi>\<^sub>A_def: "\<chi>\<^sub>A = characteristic_func m"
    by simp
  have \<chi>\<^sub>A_type[type_rule]: "\<chi>\<^sub>A : \<nat>\<^sub>c \<rightarrow> \<Omega>"
    using assms unfolding \<chi>\<^sub>A_def subobject_of_def2 by (auto, typecheck_cfuncs)

  obtain q where q_def: "q = (right_coproj \<Omega> \<nat>\<^sub>c) \<circ>\<^sub>c zero"    (*I redefined q because we only need the special case when 0 is not an element of the set!*)
    by simp
  have q_type[type_rule]: "q : one \<rightarrow> \<Omega> \<Coprod> \<nat>\<^sub>c"
    unfolding q_def by typecheck_cfuncs

  obtain f where f_def: "f = (left_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c \<f> \<circ>\<^sub>c \<beta>\<^bsub>\<Omega>\<^esub>) \<amalg>
    (((\<t> \<circ>\<^sub>c \<beta>\<^bsub>\<nat>\<^sub>c \<times>\<^sub>c one\<^esub>) \<bowtie>\<^sub>f left_cart_proj \<nat>\<^sub>c one) \<circ>\<^sub>c
  dist_prod_coprod_inv \<nat>\<^sub>c one one \<circ>\<^sub>c \<langle>successor, case_bool \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c successor\<rangle>)"
    by simp
  have f_type[type_rule]: "f : \<Omega> \<Coprod> \<nat>\<^sub>c \<rightarrow> \<Omega> \<Coprod> \<nat>\<^sub>c"
    unfolding f_def by typecheck_cfuncs

  obtain u where u_type[type_rule]: "u: \<nat>\<^sub>c \<rightarrow> \<Omega> \<Coprod> \<nat>\<^sub>c"
            and  u_zero: "u \<circ>\<^sub>c zero = q"
            and  u_successor: "f \<circ>\<^sub>c u = u \<circ>\<^sub>c successor"
    using natural_number_object_property2 by (typecheck_cfuncs, blast)

  have "FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c \<langle>
          eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c, right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
          eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c, left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>)\<^sup>\<sharp> = \<t> \<circ>\<^sub>c \<beta>\<^bsub>\<nat>\<^sub>c\<^esub>"
  proof (rule natural_number_object_func_unique[where X=\<Omega>, where f="id \<Omega>"])
    show "FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,
        right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>)\<^sup>\<sharp> : \<nat>\<^sub>c \<rightarrow> \<Omega>"
      by typecheck_cfuncs
    show "\<t> \<circ>\<^sub>c \<beta>\<^bsub>\<nat>\<^sub>c\<^esub> : \<nat>\<^sub>c \<rightarrow> \<Omega>"
      by typecheck_cfuncs
    show "id\<^sub>c \<Omega> : \<Omega> \<rightarrow> \<Omega>"
      by typecheck_cfuncs

    show "(FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c  \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
                                         eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>)\<^sup>\<sharp>) \<circ>\<^sub>c  zero =
      (\<t> \<circ>\<^sub>c \<beta>\<^bsub>\<nat>\<^sub>c\<^esub>) \<circ>\<^sub>c zero"
        proof -
          have "(FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c  \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
                                         eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>)\<^sup>\<sharp>) \<circ>\<^sub>c  zero  =
          FORALL \<nat>\<^sub>c \<circ>\<^sub>c ((IMPLIES \<circ>\<^sub>c  \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
                                         eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>)  \<circ>\<^sub>c  (id \<nat>\<^sub>c \<times>\<^sub>f zero))\<^sup>\<sharp>"
            by (typecheck_cfuncs, smt (z3) comp_associative2 sharp_comp)
          also have "... = \<t> \<circ>\<^sub>c \<beta>\<^bsub>one\<^esub>"
          proof(rule all_true_implies_FORALL_true2)
            show "(IMPLIES \<circ>\<^sub>c \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>) \<circ>\<^sub>c
                      id\<^sub>c \<nat>\<^sub>c \<times>\<^sub>f zero : \<nat>\<^sub>c \<times>\<^sub>c one \<rightarrow> \<Omega>"
              by typecheck_cfuncs
            show "\<And> n_one. n_one \<in>\<^sub>c \<nat>\<^sub>c \<times>\<^sub>c one \<Longrightarrow>
          ((IMPLIES \<circ>\<^sub>c \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>) \<circ>\<^sub>c  id\<^sub>c \<nat>\<^sub>c \<times>\<^sub>f zero) \<circ>\<^sub>c
                     n_one = \<t>"
            proof -
              fix n_one
              assume n_one_type[type_rule]: "n_one \<in>\<^sub>c \<nat>\<^sub>c \<times>\<^sub>c one"
              then obtain n where n_type[type_rule]: "n \<in>\<^sub>c \<nat>\<^sub>c" and n_def: "n_one = \<langle>n, id one\<rangle>"
                by (typecheck_cfuncs, metis cart_prod_decomp one_unique_element)
              have "((IMPLIES \<circ>\<^sub>c \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>) \<circ>\<^sub>c  id\<^sub>c \<nat>\<^sub>c \<times>\<^sub>f zero) \<circ>\<^sub>c
                     n_one =
                    (IMPLIES \<circ>\<^sub>c \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>) \<circ>\<^sub>c  (id\<^sub>c \<nat>\<^sub>c \<times>\<^sub>f zero) \<circ>\<^sub>c
                     n_one"
                using comp_associative2 by (typecheck_cfuncs, force)
              also have "... = (IMPLIES \<circ>\<^sub>c \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>) \<circ>\<^sub>c  \<langle>n, zero\<rangle>"
                by (typecheck_cfuncs, smt (z3) cfunc_cross_prod_comp_cfunc_prod id_left_unit2 id_right_unit2 id_type n_def)
              also have "... = IMPLIES \<circ>\<^sub>c \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle> \<circ>\<^sub>c  \<langle>n, zero\<rangle>"
                by (typecheck_cfuncs, simp add: comp_associative2)
              also have "... = IMPLIES \<circ>\<^sub>c \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c ,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle> \<circ>\<^sub>c  \<langle>n, zero\<rangle>,eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle> \<circ>\<^sub>c  \<langle>n, zero\<rangle>\<rangle> "
                by (typecheck_cfuncs, smt (z3) cfunc_prod_comp comp_associative2)
              also have "... = IMPLIES \<circ>\<^sub>c \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c \<circ>\<^sub>c  \<langle>n, zero\<rangle>,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c \<circ>\<^sub>c  \<langle>n, zero\<rangle>\<rangle> ,eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c \<circ>\<^sub>c  \<langle>n, zero\<rangle>,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c \<circ>\<^sub>c  \<langle>n, zero\<rangle>\<rangle> \<rangle> "
                using cfunc_prod_comp comp_associative2 by (typecheck_cfuncs, force)
              also have "... = IMPLIES \<circ>\<^sub>c \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c zero,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c n\<rangle> ,eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>zero, n\<rangle> \<rangle>"
                using left_cart_proj_cfunc_prod right_cart_proj_cfunc_prod by (typecheck_cfuncs, presburger)
              also have "... = IMPLIES \<circ>\<^sub>c \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c zero, right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c n\<rangle> ,eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>zero, n\<rangle>\<rangle>"
                using u_zero q_def by auto
              also have "... = IMPLIES \<circ>\<^sub>c \<langle>eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>zero, n\<rangle> ,eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>zero, n\<rangle>\<rangle>"
                by (typecheck_cfuncs, simp add: eq_pred_right_coproj2)
              also have "... = \<t>"
                by (typecheck_cfuncs, metis IMPLIES_false_is_true_false true_false_only_truth_values)
              then show "((IMPLIES \<circ>\<^sub>c \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>) \<circ>\<^sub>c  id\<^sub>c \<nat>\<^sub>c \<times>\<^sub>f zero) \<circ>\<^sub>c
                     n_one = \<t>"
                using calculation by auto
            qed
          qed
          also have "... = (\<t> \<circ>\<^sub>c \<beta>\<^bsub>\<nat>\<^sub>c\<^esub>) \<circ>\<^sub>c zero"
            using comp_associative2 terminal_func_comp by (typecheck_cfuncs, force)
          then show ?thesis
            using calculation by auto
    qed

    show "(FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c
          \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
          eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>)\<^sup>\<sharp>) \<circ>\<^sub>c successor
        = id\<^sub>c \<Omega> \<circ>\<^sub>c FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c
          \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
          eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>)\<^sup>\<sharp>"
    proof (rule one_separator[where X="\<nat>\<^sub>c", where Y=\<Omega>])
      show "(FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,
          right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>)\<^sup>\<sharp>) \<circ>\<^sub>c
            successor : \<nat>\<^sub>c \<rightarrow> \<Omega>"
        by typecheck_cfuncs
      show "id\<^sub>c \<Omega> \<circ>\<^sub>c FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c  \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c
          \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>)\<^sup>\<sharp> : \<nat>\<^sub>c \<rightarrow> \<Omega>"
        by typecheck_cfuncs
    next
      fix n
      assume n_type[type_rule]: "n \<in>\<^sub>c \<nat>\<^sub>c"
      show "((FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c
          \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
          eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>)\<^sup>\<sharp>) \<circ>\<^sub>c successor) \<circ>\<^sub>c n
        = (id\<^sub>c \<Omega> \<circ>\<^sub>c FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c
          \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
          eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>)\<^sup>\<sharp>) \<circ>\<^sub>c n"
      proof (cases "((FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c
          \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
          eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>)\<^sup>\<sharp>) \<circ>\<^sub>c successor) \<circ>\<^sub>c n = \<t>")
        assume "((FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c
          \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
          eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>)\<^sup>\<sharp>) \<circ>\<^sub>c successor) \<circ>\<^sub>c n = \<t>"

        then have "FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c
          \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
          eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>)\<^sup>\<sharp> \<circ>\<^sub>c successor \<circ>\<^sub>c n = \<t>"
          by (typecheck_cfuncs_prems, smt (z3) cfunc_type_def codomain_comp comp_associative)
        then have "FORALL \<nat>\<^sub>c \<circ>\<^sub>c ((IMPLIES \<circ>\<^sub>c
          \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
          eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>) \<circ>\<^sub>c (id \<nat>\<^sub>c \<times>\<^sub>f (successor \<circ>\<^sub>c n)))\<^sup>\<sharp> = \<t>"
          by (typecheck_cfuncs_prems, metis sharp_comp)
        then have "FORALL \<nat>\<^sub>c \<circ>\<^sub>c ((IMPLIES \<circ>\<^sub>c
          \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
          eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>) \<circ>\<^sub>c
          \<langle>id \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c one, (successor \<circ>\<^sub>c n) \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c one\<rangle>)\<^sup>\<sharp> = \<t>"
          by (typecheck_cfuncs, metis cfunc_cross_prod_def2)
        then have "FORALL \<nat>\<^sub>c \<circ>\<^sub>c ((IMPLIES \<circ>\<^sub>c
          \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
          eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>) \<circ>\<^sub>c
          \<langle>left_cart_proj \<nat>\<^sub>c one, (successor \<circ>\<^sub>c n) \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c one\<rangle>)\<^sup>\<sharp> = \<t>"
          by (typecheck_cfuncs, metis  id_left_unit2)
        then have "FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c
          \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
          eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle> \<circ>\<^sub>c
          \<langle>left_cart_proj \<nat>\<^sub>c one, (successor \<circ>\<^sub>c n) \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c one\<rangle>)\<^sup>\<sharp> = \<t> \<circ>\<^sub>c \<beta>\<^bsub>one\<^esub>"
          by (typecheck_cfuncs, metis  cfunc_type_def comp_associative id_right_unit2 id_type one_unique_element)
        then have "\<And> x y. x \<in>\<^sub>c \<nat>\<^sub>c \<Longrightarrow> y \<in>\<^sub>c one \<Longrightarrow>  IMPLIES \<circ>\<^sub>c
          \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
          eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle> \<circ>\<^sub>c
          \<langle>left_cart_proj \<nat>\<^sub>c one, (successor \<circ>\<^sub>c n) \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c one\<rangle> \<circ>\<^sub>c \<langle>x, y\<rangle> = \<t>"
          oops

          find_theorems "left_cart_proj"
(*      have "(FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c
            \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
            eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>)\<^sup>\<sharp>) \<circ>\<^sub>c successor
          = FORALL \<nat>\<^sub>c \<circ>\<^sub>c ((IMPLIES \<circ>\<^sub>c
            \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>,
            eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>) \<circ>\<^sub>c (id \<nat>\<^sub>c \<times>\<^sub>f successor))\<^sup>\<sharp>"
        by (typecheck_cfuncs, smt (z3) comp_associative2 sharp_comp)
      also have "... = FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c
            \<langle>(eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>) \<circ>\<^sub>c (id \<nat>\<^sub>c \<times>\<^sub>f successor),
            (eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c,left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>) \<circ>\<^sub>c (id \<nat>\<^sub>c \<times>\<^sub>f successor)\<rangle>)\<^sup>\<sharp>"
        by (typecheck_cfuncs, smt (z3) cfunc_prod_comp comp_associative2)
      also have "... = FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c
            \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>(u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c) \<circ>\<^sub>c (id \<nat>\<^sub>c \<times>\<^sub>f successor),
              (right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c) \<circ>\<^sub>c (id \<nat>\<^sub>c \<times>\<^sub>f successor)\<rangle>,
            eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c  \<circ>\<^sub>c (id \<nat>\<^sub>c \<times>\<^sub>f successor), left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c \<circ>\<^sub>c (id \<nat>\<^sub>c \<times>\<^sub>f successor)\<rangle>\<rangle>)\<^sup>\<sharp>"
        by (typecheck_cfuncs, smt (z3) cfunc_prod_comp comp_associative2)
      also have "... = FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c
            \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>(u \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c) \<circ>\<^sub>c (id \<nat>\<^sub>c \<times>\<^sub>f successor),
              (right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c) \<circ>\<^sub>c (id \<nat>\<^sub>c \<times>\<^sub>f successor)\<rangle>,
            eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>successor \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c , left_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>\<rangle>)\<^sup>\<sharp>"*)

  have "\<And>n. n \<in>\<^sub>c \<nat>\<^sub>c \<Longrightarrow> u \<circ>\<^sub>c n = right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c n \<or> (\<exists> \<omega>. \<omega> \<in>\<^sub>c \<Omega> \<and> u \<circ>\<^sub>c n = left_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c \<omega>)"
  proof auto
    fix n
    assume n_type[type_rule]: "n \<in>\<^sub>c \<nat>\<^sub>c"

  obtain q' where q'_def: "q' = \<langle>\<t>, zero\<rangle>"   (*I redefined q' because we only need the special case when 0 is not an element of the set!*)
    by simp
  have q'_type[type_rule]: "q' : one \<rightarrow> \<Omega> \<times>\<^sub>c \<nat>\<^sub>c"
    unfolding q'_def by typecheck_cfuncs

  obtain f' where f'_def: "f' = \<langle>
        AND \<circ>\<^sub>c \<langle>left_cart_proj \<Omega> \<nat>\<^sub>c, \<chi>\<^sub>A \<circ>\<^sub>c successor \<circ>\<^sub>c right_cart_proj \<Omega> \<nat>\<^sub>c\<rangle>,
        successor \<circ>\<^sub>c right_cart_proj \<Omega> \<nat>\<^sub>c
      \<rangle>"
    by simp
  have f'_type[type_rule]: "f' : \<Omega> \<times>\<^sub>c \<nat>\<^sub>c \<rightarrow> \<Omega> \<times>\<^sub>c \<nat>\<^sub>c"
    unfolding f'_def by typecheck_cfuncs

  obtain v1 where v1_def: "v1 = \<langle>FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c \<langle>leq, NOT \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>)\<^sup>\<sharp>, id \<nat>\<^sub>c\<rangle>"
    by simp
  have v1_type[type_rule]: "v1 : \<nat>\<^sub>c \<rightarrow> \<Omega> \<times>\<^sub>c \<nat>\<^sub>c"
    unfolding v1_def by typecheck_cfuncs

  have v1z_eqs_q': "v1 \<circ>\<^sub>c zero = q'"
  proof -
    have f1: "(FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c \<langle>leq, NOT \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>)\<^sup>\<sharp>) \<circ>\<^sub>c zero = \<t>"
    proof -
      have "(FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c \<langle>leq, NOT \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>)\<^sup>\<sharp>) \<circ>\<^sub>c zero
          = FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c \<langle>leq, NOT \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>)\<^sup>\<sharp> \<circ>\<^sub>c zero"
        by (typecheck_cfuncs, smt comp_associative2)
      also have "... = FORALL \<nat>\<^sub>c \<circ>\<^sub>c((IMPLIES \<circ>\<^sub>c \<langle>leq, NOT \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>) \<circ>\<^sub>c (id (\<nat>\<^sub>c) \<times>\<^sub>f zero))\<^sup>\<sharp>"
        by (typecheck_cfuncs, metis sharp_comp)
      also have "... = \<t> \<circ>\<^sub>c \<beta>\<^bsub>one\<^esub>"
      proof(rule all_true_implies_FORALL_true2)
        show "(IMPLIES \<circ>\<^sub>c \<langle>leq,NOT \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>) \<circ>\<^sub>c id\<^sub>c \<nat>\<^sub>c \<times>\<^sub>f zero : \<nat>\<^sub>c \<times>\<^sub>c one \<rightarrow> \<Omega>"
          by typecheck_cfuncs
      next
        show "\<And>xy. xy \<in>\<^sub>c \<nat>\<^sub>c \<times>\<^sub>c one \<Longrightarrow> ((IMPLIES \<circ>\<^sub>c \<langle>leq,NOT \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>) \<circ>\<^sub>c id\<^sub>c \<nat>\<^sub>c \<times>\<^sub>f zero) \<circ>\<^sub>c xy = \<t>"
        proof -
          fix n_one
          assume n_one_type[type_rule]: "n_one \<in>\<^sub>c \<nat>\<^sub>c \<times>\<^sub>c one"
          obtain n where n_def: "n_one = \<langle>n,id(one)\<rangle>" and n_type: "n \<in>\<^sub>c \<nat>\<^sub>c"
            by (metis cart_prod_decomp id_type n_one_type terminal_func_unique)
          have "((IMPLIES \<circ>\<^sub>c \<langle>leq,NOT \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>) \<circ>\<^sub>c id\<^sub>c \<nat>\<^sub>c \<times>\<^sub>f zero) \<circ>\<^sub>c n_one =
                 (IMPLIES \<circ>\<^sub>c \<langle>leq,NOT \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>) \<circ>\<^sub>c (id\<^sub>c \<nat>\<^sub>c \<times>\<^sub>f zero) \<circ>\<^sub>c n_one"
            by (typecheck_cfuncs, metis cfunc_type_def comp_associative)
          also have "... = (IMPLIES \<circ>\<^sub>c \<langle>leq,NOT \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>) \<circ>\<^sub>c \<langle>n, zero\<rangle>"
            by (typecheck_cfuncs, smt (z3) cfunc_cross_prod_comp_cfunc_prod id_left_unit2 id_right_unit2 id_type n_def n_type)
          also have "... =  IMPLIES \<circ>\<^sub>c \<langle>leq,NOT \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle> \<circ>\<^sub>c \<langle>n, zero\<rangle>"
            by (typecheck_cfuncs, metis comp_associative2 n_type)
          also have "... =  IMPLIES \<circ>\<^sub>c \<langle>leq \<circ>\<^sub>c \<langle>n, zero\<rangle> ,NOT \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c \<circ>\<^sub>c \<langle>n, zero\<rangle> \<rangle>"
            by (typecheck_cfuncs, smt (z3) cfunc_prod_comp comp_associative2 n_type)
          also have "... =  IMPLIES \<circ>\<^sub>c \<langle>leq \<circ>\<^sub>c \<langle>n, zero\<rangle> ,NOT \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c zero\<rangle>"
            using n_type right_cart_proj_cfunc_prod by (typecheck_cfuncs, presburger)
          also have "... =  IMPLIES \<circ>\<^sub>c \<langle>leq \<circ>\<^sub>c \<langle>n, zero\<rangle> ,\<t>\<rangle>"
            by (typecheck_cfuncs, metis NOT_false_is_true \<chi>\<^sub>A_def assms(2) characteristic_func_true_relative_member no_zero subobject_of_def2 true_false_only_truth_values)
          also have "... =  \<t>"
            by (typecheck_cfuncs, metis IMPLIES_false_is_true_false n_type true_false_only_truth_values)
          then show "((IMPLIES \<circ>\<^sub>c \<langle>leq,NOT \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>) \<circ>\<^sub>c id\<^sub>c \<nat>\<^sub>c \<times>\<^sub>f zero) \<circ>\<^sub>c n_one = \<t>"
            by (simp add: calculation)
        qed
      qed
      also have "... = \<t>"
        by (typecheck_cfuncs, metis id_right_unit2 id_type one_unique_element)
      then show ?thesis
        using calculation by auto
    qed
    have "v1 \<circ>\<^sub>c zero = \<langle>(FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c \<langle>leq, NOT \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>)\<^sup>\<sharp>) \<circ>\<^sub>c zero, id \<nat>\<^sub>c \<circ>\<^sub>c zero \<rangle>"
      using cfunc_prod_comp v1_def by (typecheck_cfuncs, blast)
    also have "... = q'"
      by (typecheck_cfuncs, simp add: f1 id_left_unit2 q'_def)
    then show ?thesis
      by (simp add: calculation)
  qed

  obtain v2 where v2_def: "v2 = \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u, right_coproj \<Omega> \<nat>\<^sub>c\<rangle>, id \<nat>\<^sub>c \<rangle>"
    by simp
  have v2_type[type_rule]: "v2 : \<nat>\<^sub>c \<rightarrow> \<Omega> \<times>\<^sub>c \<nat>\<^sub>c"
    unfolding v2_def by typecheck_cfuncs

  have v2z_eqs_q': "v2 \<circ>\<^sub>c zero = q'"
  proof -
    have "v2 \<circ>\<^sub>c zero  = \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u, right_coproj \<Omega> \<nat>\<^sub>c\<rangle> \<circ>\<^sub>c zero , zero\<rangle>"
      by (typecheck_cfuncs, smt (verit, best) cfunc_prod_comp comp_associative2 comp_type id_left_unit2 id_type v2_def)
    also have " ... = \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c zero , right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c zero\<rangle>  , zero\<rangle>"
      by (typecheck_cfuncs, simp add: cfunc_prod_comp)
    also have " ... = \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c zero , right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c zero\<rangle>  , zero\<rangle>"
      by (simp add: q_def u_zero)
    also have "... = \<langle>\<t>  , zero\<rangle>"
      by (typecheck_cfuncs, metis eq_pred_iff_eq)
    then show ?thesis
      by (simp add: calculation q'_def)
  qed

  have "v1 = v2"
  proof (rule natural_number_object_func_unique[where X="\<Omega> \<times>\<^sub>c \<nat>\<^sub>c", where f=f'])
    show "v1 : \<nat>\<^sub>c \<rightarrow> \<Omega> \<times>\<^sub>c \<nat>\<^sub>c" "v2 : \<nat>\<^sub>c \<rightarrow> \<Omega> \<times>\<^sub>c \<nat>\<^sub>c" "f' : \<Omega> \<times>\<^sub>c \<nat>\<^sub>c \<rightarrow> \<Omega> \<times>\<^sub>c \<nat>\<^sub>c"
      by (typecheck_cfuncs, presburger)

    show "v1 \<circ>\<^sub>c zero = v2 \<circ>\<^sub>c zero"
      by (simp add: v1z_eqs_q' v2z_eqs_q')

    show "v1 \<circ>\<^sub>c successor = f' \<circ>\<^sub>c v1"
      sorry

    show "v2 \<circ>\<^sub>c successor = f' \<circ>\<^sub>c v2"
    proof(rule one_separator[where X = "\<nat>\<^sub>c", where Y = "\<Omega> \<times>\<^sub>c \<nat>\<^sub>c"])
      show "v2 \<circ>\<^sub>c successor : \<nat>\<^sub>c \<rightarrow> \<Omega> \<times>\<^sub>c \<nat>\<^sub>c" "f' \<circ>\<^sub>c v2 : \<nat>\<^sub>c \<rightarrow> \<Omega> \<times>\<^sub>c \<nat>\<^sub>c"
        by (typecheck_cfuncs, presburger)
      show "\<And>n. n \<in>\<^sub>c \<nat>\<^sub>c \<Longrightarrow> (v2 \<circ>\<^sub>c successor) \<circ>\<^sub>c n = (f' \<circ>\<^sub>c v2) \<circ>\<^sub>c n"
      proof -
        fix n
        assume n_type[type_rule]: "n \<in>\<^sub>c \<nat>\<^sub>c"
      (*  assume case1: "u \<circ>\<^sub>c  n = right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c  n"    (*This is an assumption to try to make the calculations fall out easier*)
*)

        have "(v2 \<circ>\<^sub>c successor) \<circ>\<^sub>c n = v2 \<circ>\<^sub>c (successor  \<circ>\<^sub>c n)"
          by (typecheck_cfuncs, simp add: comp_associative2)
        also have "... = \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u, right_coproj \<Omega> \<nat>\<^sub>c\<rangle>  \<circ>\<^sub>c (successor  \<circ>\<^sub>c n), id \<nat>\<^sub>c  \<circ>\<^sub>c (successor  \<circ>\<^sub>c n)\<rangle>"
          by (typecheck_cfuncs, smt (verit, best) cfunc_prod_comp comp_associative2 comp_type v2_def)
        also have "... = \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c (successor  \<circ>\<^sub>c n), right_coproj \<Omega> \<nat>\<^sub>c  \<circ>\<^sub>c (successor  \<circ>\<^sub>c n) \<rangle>  ,  (successor  \<circ>\<^sub>c n)\<rangle>"
          using cfunc_prod_comp id_left_unit2 by (typecheck_cfuncs, force)
        also have "... = \<langle>((\<f>  \<circ>\<^sub>c \<beta>\<^bsub>\<Omega>\<^esub>) \<amalg> (eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>id \<nat>\<^sub>c , (successor  \<circ>\<^sub>c n)  \<circ>\<^sub>c \<beta>\<^bsub>\<nat>\<^sub>c\<^esub>\<rangle>)) \<circ>\<^sub>c u \<circ>\<^sub>c (successor  \<circ>\<^sub>c n) ,  (successor  \<circ>\<^sub>c n)\<rangle>"
          using eq_pred_right_coproj by (typecheck_cfuncs, presburger)
        also have "... = \<langle>((\<f>  \<circ>\<^sub>c \<beta>\<^bsub>\<Omega>\<^esub>) \<amalg> (eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>id \<nat>\<^sub>c , (successor  \<circ>\<^sub>c n)  \<circ>\<^sub>c \<beta>\<^bsub>\<nat>\<^sub>c\<^esub>\<rangle>)) \<circ>\<^sub>c (f \<circ>\<^sub>c u \<circ>\<^sub>c n) ,  (successor  \<circ>\<^sub>c n)\<rangle>"
          by (typecheck_cfuncs, simp add: comp_associative2 u_successor)
        also have "... = \<langle>(\<f> \<circ>\<^sub>c \<beta>\<^bsub>\<Omega>\<^esub>) \<amalg> (eq_pred \<nat>\<^sub>c \<circ>\<^sub>c \<langle>id\<^sub>c \<nat>\<^sub>c,(successor \<circ>\<^sub>c n) \<circ>\<^sub>c \<beta>\<^bsub>\<nat>\<^sub>c\<^esub>\<rangle>) \<circ>\<^sub>c
            (left_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c \<f> \<circ>\<^sub>c \<beta>\<^bsub>\<Omega>\<^esub>) \<amalg>
            (((\<t> \<circ>\<^sub>c \<beta>\<^bsub>\<nat>\<^sub>c \<times>\<^sub>c one\<^esub>) \<bowtie>\<^sub>f left_cart_proj \<nat>\<^sub>c one) \<circ>\<^sub>c dist_prod_coprod_inv \<nat>\<^sub>c one one \<circ>\<^sub>c \<langle>successor,case_bool \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c successor\<rangle>) \<circ>\<^sub>c
              u \<circ>\<^sub>c n,successor \<circ>\<^sub>c n\<rangle>"
          unfolding f_def by simp
        also have "... = undefined"
        proof (cases "u \<circ>\<^sub>c n = right_coproj")
        (*The above follows from the newly proved lemma!*)
        thm f_def f'_def v2_def u_successor f_type \<chi>\<^sub>A_type

(*
        have "(f' \<circ>\<^sub>c v2) \<circ>\<^sub>c n = f' \<circ>\<^sub>c (v2 \<circ>\<^sub>c n)"
          by (typecheck_cfuncs, simp add: comp_associative2)
        also have "... = f' \<circ>\<^sub>c \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u, right_coproj \<Omega> \<nat>\<^sub>c\<rangle> \<circ>\<^sub>c n , id \<nat>\<^sub>c \<circ>\<^sub>c n\<rangle>"
          unfolding v2_def by (typecheck_cfuncs, smt (z3) cfunc_prod_comp comp_associative2)
        also have "... = f' \<circ>\<^sub>c \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c n, right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c n\<rangle>  , n\<rangle>"
          by (typecheck_cfuncs, simp add: cfunc_prod_comp id_left_unit2)
        also have "... =  \<langle>AND \<circ>\<^sub>c \<langle>left_cart_proj \<Omega> \<nat>\<^sub>c, \<chi>\<^sub>A \<circ>\<^sub>c successor \<circ>\<^sub>c right_cart_proj \<Omega> \<nat>\<^sub>c\<rangle>,
        successor \<circ>\<^sub>c right_cart_proj \<Omega> \<nat>\<^sub>c \<rangle> \<circ>\<^sub>c \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u \<circ>\<^sub>c n, right_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c n\<rangle>  , n\<rangle>"
          using f'_def by force
        also have "... =  \<langle>AND \<circ>\<^sub>c \<langle>left_cart_proj \<Omega> \<nat>\<^sub>c, \<chi>\<^sub>A \<circ>\<^sub>c successor \<circ>\<^sub>c right_cart_proj \<Omega> \<nat>\<^sub>c\<rangle>,
        successor \<circ>\<^sub>c right_cart_proj \<Omega> \<nat>\<^sub>c \<rangle> \<circ>\<^sub>c \<langle>((\<f> \<circ>\<^sub>c \<beta>\<^bsub>\<Omega>\<^esub>) \<amalg> (eq_pred \<nat>\<^sub>c \<circ>\<^sub>c  \<langle>id \<nat>\<^sub>c , n \<circ>\<^sub>c \<beta>\<^bsub> \<nat>\<^sub>c\<^esub>\<rangle>)) \<circ>\<^sub>c (u \<circ>\<^sub>c n)   , n\<rangle>"
          using eq_pred_right_coproj by (typecheck_cfuncs, presburger)
        (*The above follows from the newly proved lemma!*)
*)

  qed
  then have "\<And> n. n \<in>\<^sub>c \<nat>\<^sub>c \<Longrightarrow> u \<circ>\<^sub>c n = left_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c n \<equiv> (\<forall>n'. n' \<in>\<^sub>c \<nat>\<^sub>c \<longrightarrow> n' \<le>\<^sub>\<nat> n \<longrightarrow> \<not> n' \<in>\<^bsub>\<nat>\<^sub>c\<^esub> (A, m))"
  proof -
    fix n
    assume n_type[type_rule]: "n \<in>\<^sub>c \<nat>\<^sub>c"

    have "\<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u,right_coproj \<Omega> \<nat>\<^sub>c\<rangle>,id\<^sub>c \<nat>\<^sub>c\<rangle> = \<t> \<circ>\<^sub>c \<beta>\<^bsub>\<nat>\<^sub>c\<^esub> \<equiv> u \<circ>\<^sub>c n = left_coproj \<Omega> \<nat>\<^sub>c \<circ>\<^sub>c n"
      sorry

    have "\<langle>FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c \<langle>leq,NOT \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>)\<^sup>\<sharp>,id\<^sub>c \<nat>\<^sub>c\<rangle> = \<t> \<circ>\<^sub>c \<beta>\<^bsub>\<nat>\<^sub>c\<^esub>
          \<equiv>
        (\<forall>n'. n' \<in>\<^sub>c \<nat>\<^sub>c \<longrightarrow> n' \<le>\<^sub>\<nat> n \<longrightarrow> \<not> n' \<in>\<^bsub>\<nat>\<^sub>c\<^esub> (A, m))"
      sorry

    assume "v1 = v2"
    then have "\<langle>FORALL \<nat>\<^sub>c \<circ>\<^sub>c (IMPLIES \<circ>\<^sub>c \<langle>leq,NOT \<circ>\<^sub>c \<chi>\<^sub>A \<circ>\<^sub>c right_cart_proj \<nat>\<^sub>c \<nat>\<^sub>c\<rangle>)\<^sup>\<sharp>,id\<^sub>c \<nat>\<^sub>c\<rangle> = \<t> \<circ>\<^sub>c \<beta>\<^bsub>\<nat>\<^sub>c\<^esub>
          \<equiv>
        \<langle>eq_pred (\<Omega> \<Coprod> \<nat>\<^sub>c) \<circ>\<^sub>c \<langle>u,right_coproj \<Omega> \<nat>\<^sub>c\<rangle>,id\<^sub>c \<nat>\<^sub>c\<rangle> = \<t> \<circ>\<^sub>c \<beta>\<^bsub>\<nat>\<^sub>c\<^esub>"
      unfolding v1_def v2_def by auto

end


(*
 * Copyright 2014, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 * @TAG(NICTA_BSD)
 *)

section "Additional Syntax for Word Bit Operations"

theory Word_Syntax
imports
  "HOL-Word.WordBitwise"
  WordBitwise_Signed
  Hex_Words
  Norm_Words
begin

text \<open>Additional bit and type syntax that forces word types.\<close>

type_synonym word8 = "8 word"
type_synonym word16 = "16 word"
type_synonym word32 = "32 word"
type_synonym word64 = "64 word"

lemma len8: "len_of (x :: 8 itself) = 8" by simp
lemma len16: "len_of (x :: 16 itself) = 16" by simp
lemma len32: "len_of (x :: 32 itself) = 32" by simp
lemma len64: "len_of (x :: 64 itself) = 64" by simp

abbreviation
  wordNOT  :: "'a::len0 word \<Rightarrow> 'a word"      ("~~ _" [70] 71)
where
  "~~ x == NOT x"

abbreviation
  wordAND  :: "'a::len0 word \<Rightarrow> 'a word \<Rightarrow> 'a word" (infixr "&&" 64)
where
  "a && b == a AND b"

abbreviation
  wordOR   :: "'a::len0 word \<Rightarrow> 'a word \<Rightarrow> 'a word" (infixr "||"  59)
where
  "a || b == a OR b"

abbreviation
  wordXOR  :: "'a::len0 word \<Rightarrow> 'a word \<Rightarrow> 'a word" (infixr "xor" 59)
where
  "a xor b == a XOR b"

(* testing for presence of word_bitwise *)
lemma "((x :: word32) >> 3) AND 7 = (x AND 56) >> 3"
  by word_bitwise

(* FIXME: move to Word distribution *)
lemma bin_nth_minus_Bit0[simp]:
  "0 < n \<Longrightarrow> bin_nth (numeral (num.Bit0 w)) n = bin_nth (numeral w) (n - 1)"
  by (cases n; simp)

lemma bin_nth_minus_Bit1[simp]:
  "0 < n \<Longrightarrow> bin_nth (numeral (num.Bit1 w)) n = bin_nth (numeral w) (n - 1)"
  by (cases n; simp)

end


(* Currently not used, but may be of general use. Keep in Aux! *)
theory On_Stack
imports Collections.Refine_Dflt
begin
subsection \<open>Implementation of a stack with efficient on-stack operation\<close>
text \<open>This generic implementation combines a stack implementation and
  a set implementation that is used to keep track of the elements on the stack.
  It requires a distinct stack, i.e., no duplicate elements on the stack.

  Note that this generic implementation has to be instantiated to a
  concrete stack-relation in order to avoid looping of the autoref-tool,
  which otherwise tries to instantiate the stack-implementation with itself
  indefinitely often.
\<close>

definition stack_rel_internal_def: "stack_rel lrel srel vrel \<equiv> {
  ((li,si),l). (li,l)\<in>\<langle>vrel\<rangle>lrel \<and> (si,set l)\<in>\<langle>vrel\<rangle>srel \<and> distinct l}"

lemma stack_rel_def: "\<langle>vrel\<rangle>stack_rel lrel srel \<equiv> {
  ((li,si),l). (li,l)\<in>\<langle>vrel\<rangle>lrel \<and> (si,set l)\<in>\<langle>vrel\<rangle>srel \<and> distinct l}"
  unfolding stack_rel_internal_def relAPP_def by auto

lemmas [autoref_rel_intf]
  = REL_INTFI[of "stack_rel lrel srel" i_list for lrel srel]

context
  fixes lrel :: "('xi \<times> 'x) set \<Rightarrow> ('xli \<times> 'x list) set"
  and srel :: "('xi \<times> 'x) set \<Rightarrow> ('xsi \<times> 'x set) set"
begin

context begin interpretation autoref_syn .

lemma autoref_stack_empty[OF GEN_OP_D GEN_OP_D]:
  assumes "(el,[])\<in>\<langle>vrel\<rangle>lrel"
  assumes "(es,{})\<in>\<langle>vrel\<rangle>srel"
  shows "((el,es),[]) \<in> \<langle>vrel\<rangle>stack_rel lrel srel"
  using assms unfolding stack_rel_def
  by auto

primrec stack_push::"_::type"
  where "stack_push push ins (el,es) v = (push el v, ins v es)"

lemma autoref_stack_sng:
  assumes "GEN_OP lsng op_list_singleton (vrel \<rightarrow> \<langle>vrel\<rangle>lrel)"
  assumes "GEN_OP sins insert (vrel \<rightarrow> \<langle>vrel\<rangle>srel \<rightarrow> \<langle>vrel\<rangle>srel)"
  assumes "GEN_OP semp {} (\<langle>vrel\<rangle>srel)"
  shows "(\<lambda>v. (lsng v, sins v semp),op_list_singleton)
    \<in> vrel \<rightarrow> \<langle>vrel\<rangle>stack_rel lrel srel"
  using assms
  unfolding stack_rel_def autoref_tag_defs
  by (fastforce simp: op_list_singleton_def[abs_def] dest: fun_relD)

primrec stack_pop::"_::type"
  where "stack_pop lpop ltop del (el,es)
    = (let v = ltop el; el = lpop el; es = del v es in (el,es))"

lemma autoref_stack_pop:
  assumes POPR: "\<And>el l. \<lbrakk> (el,l)\<in>\<langle>vrel\<rangle>lrel; l\<noteq>[] \<rbrakk>
    \<Longrightarrow> (lpop el,(OP butlast ::: \<langle>vrel\<rangle>lrel \<rightarrow> \<langle>vrel\<rangle>lrel)$l)\<in> \<langle>vrel\<rangle>lrel"
  assumes TOPR: "\<And>el l. \<lbrakk> (el,l)\<in>\<langle>vrel\<rangle>lrel; l\<noteq>[] \<rbrakk>
    \<Longrightarrow> (ltop el,(OP last ::: \<langle>vrel\<rangle>lrel \<rightarrow> vrel)$l)\<in> vrel"
  assumes DELR: "GEN_OP del op_set_delete (vrel \<rightarrow> \<langle>vrel\<rangle>srel \<rightarrow> \<langle>vrel\<rangle>srel)"
  assumes NE: "SIDE_PRECOND (l \<noteq> [])"
  assumes R: "(si,l)\<in>\<langle>vrel\<rangle>stack_rel lrel srel"
  shows "(stack_pop lpop ltop del si,
    (OP butlast ::: \<langle>vrel\<rangle>stack_rel lrel srel \<rightarrow> \<langle>vrel\<rangle>stack_rel lrel srel)
      $l) \<in> \<langle>vrel\<rangle>stack_rel lrel srel"
proof -
  note POPR TOPR DELR
  note [param] = this[unfolded autoref_tag_defs]

  have AUX: "set (butlast l) = op_set_delete (last l) (set l)"
    using NE R unfolding stack_rel_def
    by (cases l rule: rev_cases) auto

  show ?thesis
    using NE R unfolding stack_rel_def autoref_tag_defs
    apply (clarsimp simp: distinct_butlast, intro conjI)
    apply parametricity
    apply (subst AUX)
    apply parametricity
    done
qed

lemma autoref_stack_set:
  shows "(snd, set) \<in> \<langle>vrel\<rangle>stack_rel lrel srel \<rightarrow> \<langle>vrel\<rangle>srel"
  unfolding stack_rel_def
  by auto

lemma autoref_stack_is_Nil:
  assumes "GEN_OP ini is_Nil (\<langle>vrel\<rangle>lrel \<rightarrow> bool_rel)"
  shows "(ini o fst, is_Nil) \<in> \<langle>vrel\<rangle>stack_rel lrel srel \<rightarrow> bool_rel"
  using assms unfolding stack_rel_def
  by (auto dest: fun_relD)

lemma autoref_stack_ltop:
  assumes TOPR: "\<And>el l. \<lbrakk> (el,l)\<in>\<langle>vrel\<rangle>lrel; l\<noteq>[] \<rbrakk>
    \<Longrightarrow> (ltop el,(OP last ::: \<langle>vrel\<rangle>lrel \<rightarrow> vrel)$l)\<in> vrel"
  assumes NE: "SIDE_PRECOND (l \<noteq> [])"
  assumes R: "(si,l)\<in>\<langle>vrel\<rangle>stack_rel lrel srel"
  shows "(ltop (fst si), (OP last ::: \<langle>vrel\<rangle>stack_rel lrel srel \<rightarrow> vrel)$l) \<in> vrel"
  using assms unfolding stack_rel_def
  by (auto dest: fun_relD)

lemmas stack_autoref_rules
  = autoref_stack_empty autoref_stack_push autoref_stack_sng autoref_stack_pop
    autoref_stack_set autoref_stack_is_Nil autoref_stack_ltop

end

end

abbreviation "as_ahs_stack_rel \<equiv> stack_rel as_rel dflt_ahs_rel"
lemmas as_ahs_stack_rules
  = stack_autoref_rules[where lrel = as_rel and srel = dflt_ahs_rel]

schematic_goal
  notes [autoref_rules] = as_ahs_stack_rules
  shows "(?c::?'c, set (butlast ([1::nat]@[2]))) \<in> ?R"
  apply (autoref (trace,keep_goal))
  done

end


(*  Title:      HOL/TLA/Memory/ProcedureInterface.thy
    Author:     Stephan Merz, University of Munich
*)

section {* Procedure interface for RPC-Memory components *}

theory ProcedureInterface
imports "../TLA" RPCMemoryParams
begin

typedecl ('a,'r) chan
  (* type of channels with argument type 'a and return type 'r.
     we model a channel as an array of variables (of type chan)
     rather than a single array-valued variable because the
     notation gets a little simpler.
  *)
type_synonym ('a,'r) channel =" (PrIds => ('a,'r) chan) stfun"

consts
  (* data-level functions *)
  cbit          :: "('a,'r) chan => bit"
  rbit          :: "('a,'r) chan => bit"
  arg           :: "('a,'r) chan => 'a"
  res           :: "('a,'r) chan => 'r"

  (* state functions *)
  caller        :: "('a,'r) channel => (PrIds => (bit * 'a)) stfun"
  rtrner        :: "('a,'r) channel => (PrIds => (bit * 'r)) stfun"

  (* state predicates *)
  Calling   :: "('a,'r) channel => PrIds => stpred"

  (* actions *)
  ACall      :: "('a,'r) channel => PrIds => 'a stfun => action"
  AReturn    :: "('a,'r) channel => PrIds => 'r stfun => action"

  (* temporal formulas *)
  PLegalCaller      :: "('a,'r) channel => PrIds => temporal"
  LegalCaller       :: "('a,'r) channel => temporal"
  PLegalReturner    :: "('a,'r) channel => PrIds => temporal"
  LegalReturner     :: "('a,'r) channel => temporal"

  (* slice through array-valued state function *)
  slice        :: "('a => 'b) stfun => 'a => 'b stfun"

syntax
  "_slice"    :: "[lift, 'a] => lift"      ("(_!_)" [70,70] 70)

  "_Call"     :: "['a, 'b, lift] => lift"    ("(Call _ _ _)" [90,90,90] 90)
  "_Return"   :: "['a, 'b, lift] => lift"    ("(Return _ _ _)" [90,90,90] 90)

translations
  "_slice"  ==  "CONST slice"

  "_Call"   ==  "CONST ACall"
  "_Return" ==  "CONST AReturn"

defs
  slice_def:     "(PRED (x!i)) s == x s i"

  caller_def:    "caller ch   == %s p. (cbit (ch s p), arg (ch s p))"
  rtrner_def:    "rtrner ch   == %s p. (rbit (ch s p), res (ch s p))"

  Calling_def:   "Calling ch p  == PRED cbit< ch!p > ~= rbit< ch!p >"
  Call_def:      "(ACT Call ch p v)   == ACT  ~ $Calling ch p
                                     & (cbit<ch!p>$ ~= $rbit<ch!p>)
                                     & (arg<ch!p>$ = $v)"
  Return_def:    "(ACT Return ch p v) == ACT  $Calling ch p
                                     & (rbit<ch!p>$ = $cbit<ch!p>)
                                     & (res<ch!p>$ = $v)"
  PLegalCaller_def:      "PLegalCaller ch p == TEMP
                             Init(~ Calling ch p)
                             & [][ ? a. Call ch p a ]_((caller ch)!p)"
  LegalCaller_def:       "LegalCaller ch == TEMP (! p. PLegalCaller ch p)"
  PLegalReturner_def:    "PLegalReturner ch p == TEMP
                                [][ ? v. Return ch p v ]_((rtrner ch)!p)"
  LegalReturner_def:     "LegalReturner ch == TEMP (! p. PLegalReturner ch p)"

declare slice_def [simp]

lemmas Procedure_defs = caller_def rtrner_def Calling_def Call_def Return_def
  PLegalCaller_def LegalCaller_def PLegalReturner_def LegalReturner_def

(* Calls and returns change their subchannel *)
lemma Call_changed: "|- Call ch p v --> <Call ch p v>_((caller ch)!p)"
  by (auto simp: angle_def Call_def caller_def Calling_def)

lemma Return_changed: "|- Return ch p v --> <Return ch p v>_((rtrner ch)!p)"
  by (auto simp: angle_def Return_def rtrner_def Calling_def)

end


(*  Title:      HOL/Auth/Yahalom_Bad.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1996  University of Cambridge
*)

section\<open>The Yahalom Protocol: A Flawed Version\<close>

theory Yahalom_Bad imports Public begin

text\<open>
Demonstrates of why Oops is necessary.  This protocol can be attacked because
it doesn't keep NB secret, but without Oops it can be "verified" anyway.
The issues are discussed in lcp's LICS 2000 invited lecture.
\<close>

inductive_set yahalom :: "event list set"
  where
         (*Initial trace is empty*)
   Nil:  "[] \<in> yahalom"

         (*The spy MAY say anything he CAN say.  We do not expect him to
           invent new nonces here, but he can also use NS1.  Common to
           all similar protocols.*)
 | Fake: "\<lbrakk>evsf \<in> yahalom;  X \<in> synth (analz (knows Spy evsf))\<rbrakk>
          \<Longrightarrow> Says Spy B X  # evsf \<in> yahalom"

         (*A message that has been sent can be received by the
           intended recipient.*)
 | Reception: "\<lbrakk>evsr \<in> yahalom;  Says A B X \<in> set evsr\<rbrakk>
               \<Longrightarrow> Gets B X # evsr \<in> yahalom"

         (*Alice initiates a protocol run*)
 | YM1:  "\<lbrakk>evs1 \<in> yahalom;  Nonce NA \<notin> used evs1\<rbrakk>
          \<Longrightarrow> Says A B \<lbrace>Agent A, Nonce NA\<rbrace> # evs1 \<in> yahalom"

         (*Bob's response to Alice's message.*)
 | YM2:  "\<lbrakk>evs2 \<in> yahalom;  Nonce NB \<notin> used evs2;
             Gets B \<lbrace>Agent A, Nonce NA\<rbrace> \<in> set evs2\<rbrakk>
          \<Longrightarrow> Says B Server
                  \<lbrace>Agent B, Nonce NB, Crypt (shrK B) \<lbrace>Agent A, Nonce NA\<rbrace>\<rbrace>
                # evs2 \<in> yahalom"

         (*The Server receives Bob's message.  He responds by sending a
            new session key to Alice, with a packet for forwarding to Bob.*)
 | YM3:  "\<lbrakk>evs3 \<in> yahalom;  Key KAB \<notin> used evs3;  KAB \<in> symKeys;
             Gets Server
                  \<lbrace>Agent B, Nonce NB, Crypt (shrK B) \<lbrace>Agent A, Nonce NA\<rbrace>\<rbrace>
               \<in> set evs3\<rbrakk>
          \<Longrightarrow> Says Server A
                   \<lbrace>Crypt (shrK A) \<lbrace>Agent B, Key KAB, Nonce NA, Nonce NB\<rbrace>,
                     Crypt (shrK B) \<lbrace>Agent A, Key KAB\<rbrace>\<rbrace>
                # evs3 \<in> yahalom"

         (*Alice receives the Server's (?) message, checks her Nonce, and
           uses the new session key to send Bob his Nonce.  The premise
           A \<noteq> Server is needed to prove Says_Server_not_range.*)
 | YM4:  "\<lbrakk>evs4 \<in> yahalom;  A \<noteq> Server;  K \<in> symKeys;
             Gets A \<lbrace>Crypt(shrK A) \<lbrace>Agent B, Key K, Nonce NA, Nonce NB\<rbrace>, X\<rbrace>
                \<in> set evs4;
             Says A B \<lbrace>Agent A, Nonce NA\<rbrace> \<in> set evs4\<rbrakk>
          \<Longrightarrow> Says A B \<lbrace>X, Crypt K (Nonce NB)\<rbrace> # evs4 \<in> yahalom"

declare Says_imp_knows_Spy [THEN analz.Inj, dest]
declare parts.Body  [dest]
declare Fake_parts_insert_in_Un  [dest]
declare analz_into_parts [dest]

text\<open>A "possibility property": there are traces that reach the end\<close>
lemma "\<lbrakk>A \<noteq> Server; Key K \<notin> used []; K \<in> symKeys\<rbrakk>
       \<Longrightarrow> \<exists>X NB. \<exists>evs \<in> yahalom.
              Says A B \<lbrace>X, Crypt K (Nonce NB)\<rbrace> \<in> set evs"
apply (intro exI bexI)
apply (rule_tac [2] yahalom.Nil
                    [THEN yahalom.YM1, THEN yahalom.Reception,
                     THEN yahalom.YM2, THEN yahalom.Reception,
                     THEN yahalom.YM3, THEN yahalom.Reception,
                     THEN yahalom.YM4])
apply (possibility, simp add: used_Cons)
done

subsection\<open>Regularity Lemmas for Yahalom\<close>

lemma Gets_imp_Says:
     "\<lbrakk>Gets B X \<in> set evs; evs \<in> yahalom\<rbrakk> \<Longrightarrow> \<exists>A. Says A B X \<in> set evs"
by (erule rev_mp, erule yahalom.induct, auto)

(*Must be proved separately for each protocol*)
lemma Gets_imp_knows_Spy:
     "\<lbrakk>Gets B X \<in> set evs; evs \<in> yahalom\<rbrakk>  \<Longrightarrow> X \<in> knows Spy evs"
by (blast dest!: Gets_imp_Says Says_imp_knows_Spy)

declare Gets_imp_knows_Spy [THEN analz.Inj, dest]

subsection\<open>For reasoning about the encrypted portion of messages\<close>

text\<open>Lets us treat YM4 using a similar argument as for the Fake case.\<close>
lemma YM4_analz_knows_Spy:
     "\<lbrakk>Gets A \<lbrace>Crypt (shrK A) Y, X\<rbrace> \<in> set evs;  evs \<in> yahalom\<rbrakk>
      \<Longrightarrow> X \<in> analz (knows Spy evs)"
by blast

lemmas YM4_parts_knows_Spy =
       YM4_analz_knows_Spy [THEN analz_into_parts]

text\<open>Theorems of the form \<^term>\<open>X \<notin> parts (knows Spy evs)\<close> imply
            that NOBODY sends messages containing X!\<close>

text\<open>Spy never sees a good agent's shared key!\<close>
lemma Spy_see_shrK [simp]:
     "evs \<in> yahalom \<Longrightarrow> (Key (shrK A) \<in> parts (knows Spy evs)) = (A \<in> bad)"
apply (erule yahalom.induct, force,
       drule_tac [6] YM4_parts_knows_Spy, simp_all, blast+)
done

lemma Spy_analz_shrK [simp]:
     "evs \<in> yahalom \<Longrightarrow> (Key (shrK A) \<in> analz (knows Spy evs)) = (A \<in> bad)"
by auto

lemma Spy_see_shrK_D [dest!]:
     "\<lbrakk>Key (shrK A) \<in> parts (knows Spy evs);  evs \<in> yahalom\<rbrakk> \<Longrightarrow> A \<in> bad"
by (blast dest: Spy_see_shrK)

text\<open>Nobody can have used non-existent keys!
    Needed to apply \<open>analz_insert_Key\<close>\<close>
lemma new_keys_not_used [simp]:
    "\<lbrakk>Key K \<notin> used evs; K \<in> symKeys; evs \<in> yahalom\<rbrakk>
     \<Longrightarrow> K \<notin> keysFor (parts (spies evs))"
apply (erule rev_mp)
apply (erule yahalom.induct, force,
       frule_tac [6] YM4_parts_knows_Spy, simp_all)
txt\<open>Fake\<close>
apply (force dest!: keysFor_parts_insert, auto)
done

subsection\<open>Secrecy Theorems\<close>

(****
 The following is to prove theorems of the form

  Key K \<in> analz (insert (Key KAB) (knows Spy evs)) \<Longrightarrow>
  Key K \<in> analz (knows Spy evs)

 A more general formula must be proved inductively.
****)

subsection\<open>Session keys are not used to encrypt other session keys\<close>

lemma analz_image_freshK [rule_format]:
 "evs \<in> yahalom \<Longrightarrow>
   \<forall>K KK. KK \<subseteq> - (range shrK) \<longrightarrow>
          (Key K \<in> analz (Key`KK \<union> (knows Spy evs))) =
          (K \<in> KK | Key K \<in> analz (knows Spy evs))"
by (erule yahalom.induct,
    drule_tac [7] YM4_analz_knows_Spy, analz_freshK, spy_analz, blast)

lemma analz_insert_freshK:
     "\<lbrakk>evs \<in> yahalom;  KAB \<notin> range shrK\<rbrakk> \<Longrightarrow>
      (Key K \<in> analz (insert (Key KAB) (knows Spy evs))) =
      (K = KAB | Key K \<in> analz (knows Spy evs))"
by (simp only: analz_image_freshK analz_image_freshK_simps)

text\<open>The Key K uniquely identifies the Server's  message.\<close>
lemma unique_session_keys:
     "\<lbrakk>Says Server A
          \<lbrace>Crypt (shrK A) \<lbrace>Agent B, Key K, na, nb\<rbrace>, X\<rbrace> \<in> set evs;
        Says Server A'
          \<lbrace>Crypt (shrK A') \<lbrace>Agent B', Key K, na', nb'\<rbrace>, X'\<rbrace> \<in> set evs;
        evs \<in> yahalom\<rbrakk>
     \<Longrightarrow> A=A' \<and> B=B' \<and> na=na' \<and> nb=nb'"
apply (erule rev_mp, erule rev_mp)
apply (erule yahalom.induct, simp_all)
txt\<open>YM3, by freshness, and YM4\<close>
apply blast+
done

text\<open>Crucial secrecy property: Spy does not see the keys sent in msg YM3\<close>
lemma secrecy_lemma:
     "\<lbrakk>A \<notin> bad;  B \<notin> bad;  evs \<in> yahalom\<rbrakk>
      \<Longrightarrow> Says Server A
            \<lbrace>Crypt (shrK A) \<lbrace>Agent B, Key K, na, nb\<rbrace>,
              Crypt (shrK B) \<lbrace>Agent A, Key K\<rbrace>\<rbrace>
           \<in> set evs \<longrightarrow>
          Key K \<notin> analz (knows Spy evs)"
apply (erule yahalom.induct, force, drule_tac [6] YM4_analz_knows_Spy)
apply (simp_all add: pushes analz_insert_eq analz_insert_freshK, spy_analz)  (*Fake*)
apply (blast dest: unique_session_keys)  (*YM3*)
done

text\<open>Final version\<close>
lemma Spy_not_see_encrypted_key:
     "\<lbrakk>Says Server A
            \<lbrace>Crypt (shrK A) \<lbrace>Agent B, Key K, na, nb\<rbrace>,
              Crypt (shrK B) \<lbrace>Agent A, Key K\<rbrace>\<rbrace>
           \<in> set evs;
         A \<notin> bad;  B \<notin> bad;  evs \<in> yahalom\<rbrakk>
      \<Longrightarrow> Key K \<notin> analz (knows Spy evs)"
by (blast dest: secrecy_lemma)

subsection\<open>Security Guarantee for A upon receiving YM3\<close>

text\<open>If the encrypted message appears then it originated with the Server\<close>
lemma A_trusts_YM3:
     "\<lbrakk>Crypt (shrK A) \<lbrace>Agent B, Key K, na, nb\<rbrace> \<in> parts (knows Spy evs);
         A \<notin> bad;  evs \<in> yahalom\<rbrakk>
       \<Longrightarrow> Says Server A
            \<lbrace>Crypt (shrK A) \<lbrace>Agent B, Key K, na, nb\<rbrace>,
              Crypt (shrK B) \<lbrace>Agent A, Key K\<rbrace>\<rbrace>
           \<in> set evs"
apply (erule rev_mp)
apply (erule yahalom.induct, force,
       frule_tac [6] YM4_parts_knows_Spy, simp_all)
txt\<open>Fake, YM3\<close>
apply blast+
done

text\<open>The obvious combination of \<open>A_trusts_YM3\<close> with
  \<open>Spy_not_see_encrypted_key\<close>\<close>
lemma A_gets_good_key:
     "\<lbrakk>Crypt (shrK A) \<lbrace>Agent B, Key K, na, nb\<rbrace> \<in> parts (knows Spy evs);
         A \<notin> bad;  B \<notin> bad;  evs \<in> yahalom\<rbrakk>
      \<Longrightarrow> Key K \<notin> analz (knows Spy evs)"
by (blast dest!: A_trusts_YM3 Spy_not_see_encrypted_key)

subsection\<open>Security Guarantees for B upon receiving YM4\<close>

text\<open>B knows, by the first part of A's message, that the Server distributed
  the key for A and B.  But this part says nothing about nonces.\<close>
lemma B_trusts_YM4_shrK:
     "\<lbrakk>Crypt (shrK B) \<lbrace>Agent A, Key K\<rbrace> \<in> parts (knows Spy evs);
         B \<notin> bad;  evs \<in> yahalom\<rbrakk>
      \<Longrightarrow> \<exists>NA NB. Says Server A
                      \<lbrace>Crypt (shrK A) \<lbrace>Agent B, Key K, Nonce NA, Nonce NB\<rbrace>,
                        Crypt (shrK B) \<lbrace>Agent A, Key K\<rbrace>\<rbrace>
                     \<in> set evs"
apply (erule rev_mp)
apply (erule yahalom.induct, force,
       frule_tac [6] YM4_parts_knows_Spy, simp_all)
txt\<open>Fake, YM3\<close>
apply blast+
done

subsection\<open>The Flaw in the Model\<close>

text\<open>Up to now, the reasoning is similar to standard Yahalom.  Now the
    doubtful reasoning occurs.  We should not be assuming that an unknown
    key is secure, but the model allows us to: there is no Oops rule to
    let session keys become compromised.\<close>

text\<open>B knows, by the second part of A's message, that the Server distributed
  the key quoting nonce NB.  This part says nothing about agent names.
  Secrecy of K is assumed; the valid Yahalom proof uses (and later proves)
  the secrecy of NB.\<close>
lemma B_trusts_YM4_newK [rule_format]:
     "\<lbrakk>Key K \<notin> analz (knows Spy evs);  evs \<in> yahalom\<rbrakk>
      \<Longrightarrow> Crypt K (Nonce NB) \<in> parts (knows Spy evs) \<longrightarrow>
          (\<exists>A B NA. Says Server A
                      \<lbrace>Crypt (shrK A) \<lbrace>Agent B, Key K,
                                Nonce NA, Nonce NB\<rbrace>,
                        Crypt (shrK B) \<lbrace>Agent A, Key K\<rbrace>\<rbrace>
                     \<in> set evs)"
apply (erule rev_mp)
apply (erule yahalom.induct, force,
       frule_tac [6] YM4_parts_knows_Spy)
apply (analz_mono_contra, simp_all)
txt\<open>Fake\<close>
apply blast
txt\<open>YM3\<close>
apply blast
txt\<open>A is uncompromised because NB is secure
  A's certificate guarantees the existence of the Server message\<close>
apply (blast dest!: Gets_imp_Says Crypt_Spy_analz_bad
             dest: Says_imp_spies
                   parts.Inj [THEN parts.Fst, THEN A_trusts_YM3])
done

text\<open>B's session key guarantee from YM4.  The two certificates contribute to a
  single conclusion about the Server's message.\<close>
lemma B_trusts_YM4:
     "\<lbrakk>Gets B \<lbrace>Crypt (shrK B) \<lbrace>Agent A, Key K\<rbrace>,
                  Crypt K (Nonce NB)\<rbrace> \<in> set evs;
         Says B Server
           \<lbrace>Agent B, Nonce NB, Crypt (shrK B) \<lbrace>Agent A, Nonce NA\<rbrace>\<rbrace>
           \<in> set evs;
         A \<notin> bad;  B \<notin> bad;  evs \<in> yahalom\<rbrakk>
       \<Longrightarrow> \<exists>na nb. Says Server A
                   \<lbrace>Crypt (shrK A) \<lbrace>Agent B, Key K, na, nb\<rbrace>,
                     Crypt (shrK B) \<lbrace>Agent A, Key K\<rbrace>\<rbrace>
             \<in> set evs"
by (blast dest: B_trusts_YM4_newK B_trusts_YM4_shrK Spy_not_see_encrypted_key
                unique_session_keys)

text\<open>The obvious combination of \<open>B_trusts_YM4\<close> with
  \<open>Spy_not_see_encrypted_key\<close>\<close>
lemma B_gets_good_key:
     "\<lbrakk>Gets B \<lbrace>Crypt (shrK B) \<lbrace>Agent A, Key K\<rbrace>,
                  Crypt K (Nonce NB)\<rbrace> \<in> set evs;
         Says B Server
           \<lbrace>Agent B, Nonce NB, Crypt (shrK B) \<lbrace>Agent A, Nonce NA\<rbrace>\<rbrace>
           \<in> set evs;
         A \<notin> bad;  B \<notin> bad;  evs \<in> yahalom\<rbrakk>
      \<Longrightarrow> Key K \<notin> analz (knows Spy evs)"
by (blast dest!: B_trusts_YM4 Spy_not_see_encrypted_key)

(*** Authenticating B to A: these proofs are not considered.
     They are irrelevant to showing the need for Oops. ***)

(*** Authenticating A to B using the certificate Crypt K (Nonce NB) ***)

text\<open>Assuming the session key is secure, if both certificates are present then
  A has said NB.  We can't be sure about the rest of A's message, but only
  NB matters for freshness.\<close>
lemma A_Said_YM3_lemma [rule_format]:
     "evs \<in> yahalom
      \<Longrightarrow> Key K \<notin> analz (knows Spy evs) \<longrightarrow>
          Crypt K (Nonce NB) \<in> parts (knows Spy evs) \<longrightarrow>
          Crypt (shrK B) \<lbrace>Agent A, Key K\<rbrace> \<in> parts (knows Spy evs) \<longrightarrow>
          B \<notin> bad \<longrightarrow>
          (\<exists>X. Says A B \<lbrace>X, Crypt K (Nonce NB)\<rbrace> \<in> set evs)"
apply (erule yahalom.induct, force,
       frule_tac [6] YM4_parts_knows_Spy)
apply (analz_mono_contra, simp_all)
txt\<open>Fake\<close>
apply blast
txt\<open>YM3: by \<open>new_keys_not_used\<close>, the message
   \<^term>\<open>Crypt K (Nonce NB)\<close> could not exist\<close>
apply (force dest!: Crypt_imp_keysFor)
txt\<open>YM4: was \<^term>\<open>Crypt K (Nonce NB)\<close> the very last message?
    If not, use the induction hypothesis\<close>
apply (simp add: ex_disj_distrib)
txt\<open>yes: apply unicity of session keys\<close>
apply (blast dest!: Gets_imp_Says A_trusts_YM3 B_trusts_YM4_shrK
                    Crypt_Spy_analz_bad
             dest: Says_imp_knows_Spy [THEN parts.Inj] unique_session_keys)
done

text\<open>If B receives YM4 then A has used nonce NB (and therefore is alive).
  Moreover, A associates K with NB (thus is talking about the same run).
  Other premises guarantee secrecy of K.\<close>
lemma YM4_imp_A_Said_YM3 [rule_format]:
     "\<lbrakk>Gets B \<lbrace>Crypt (shrK B) \<lbrace>Agent A, Key K\<rbrace>,
                  Crypt K (Nonce NB)\<rbrace> \<in> set evs;
         Says B Server
           \<lbrace>Agent B, Nonce NB, Crypt (shrK B) \<lbrace>Agent A, Nonce NA\<rbrace>\<rbrace>
           \<in> set evs;
         A \<notin> bad;  B \<notin> bad;  evs \<in> yahalom\<rbrakk>
      \<Longrightarrow> \<exists>X. Says A B \<lbrace>X, Crypt K (Nonce NB)\<rbrace> \<in> set evs"
by (blast intro!: A_Said_YM3_lemma
          dest: Spy_not_see_encrypted_key B_trusts_YM4 Gets_imp_Says)

end