theory AOT_misc
  imports AOT_NaturalNumbers
begin

section\<open>Miscellaneous Theorems\<close>

AOT_theorem PossiblyNumbersEmptyPropertyImpliesZero:
  \<open>\<diamond>Numbers(x,[\<lambda>z O!z & z \<noteq>\<^sub>E z]) \<rightarrow> x = 0\<close>
proof(rule "\<rightarrow>I")
  AOT_have \<open>Rigid([\<lambda>z O!z & z \<noteq>\<^sub>E z])\<close>
  proof (safe intro!: "df-rigid-rel:1"[THEN "\<equiv>\<^sub>d\<^sub>fI"] "&I" "cqt:2";
         rule RN; safe intro!: GEN "\<rightarrow>I")
    AOT_modally_strict {
      fix x
      AOT_assume \<open>[\<lambda>z O!z & z \<noteq>\<^sub>E z]x\<close>
      AOT_hence \<open>O!x & x \<noteq>\<^sub>E x\<close> by (rule "\<beta>\<rightarrow>C")
      moreover AOT_have \<open>x =\<^sub>E x\<close> using calculation[THEN "&E"(1)]
        by (metis "ord=Eequiv:1" "vdash-properties:10")
      ultimately AOT_have \<open>x =\<^sub>E x & \<not>x =\<^sub>E x\<close>
        by (metis "con-dis-i-e:1" "con-dis-i-e:2:b" "intro-elim:3:a" "thm-neg=E")
      AOT_thus \<open>\<box>[\<lambda>z O!z & z \<noteq>\<^sub>E z]x\<close> using "raa-cor:1" by blast
    }
  qed
  AOT_hence \<open>\<box>\<forall>x (Numbers(x,[\<lambda>z O!z & z \<noteq>\<^sub>E z]) \<rightarrow> \<box>Numbers(x,[\<lambda>z O!z & z \<noteq>\<^sub>E z]))\<close>
    by (safe intro!: "num-cont:2"[unvarify G, THEN "\<rightarrow>E"] "cqt:2")
  AOT_hence \<open>\<forall>x \<box>(Numbers(x,[\<lambda>z O!z & z \<noteq>\<^sub>E z]) \<rightarrow> \<box>Numbers(x,[\<lambda>z O!z & z \<noteq>\<^sub>E z]))\<close>
    using "BFs:2"[THEN "\<rightarrow>E"] by blast
  AOT_hence \<open>\<box>(Numbers(x,[\<lambda>z O!z & z \<noteq>\<^sub>E z]) \<rightarrow> \<box>Numbers(x,[\<lambda>z O!z & z \<noteq>\<^sub>E z]))\<close>
    using "\<forall>E"(2) by auto
  moreover AOT_assume \<open>\<diamond>Numbers(x,[\<lambda>z O!z & z \<noteq>\<^sub>E z])\<close>
  ultimately AOT_have \<open>\<^bold>\<A>Numbers(x,[\<lambda>z O!z & z \<noteq>\<^sub>E z])\<close>
    using "sc-eq-box-box:1"[THEN "\<equiv>E"(1), THEN "\<rightarrow>E", THEN "nec-imp-act"[THEN "\<rightarrow>E"]]
    by blast
  AOT_hence \<open>Numbers(x,[\<lambda>z \<^bold>\<A>[\<lambda>z O!z & z \<noteq>\<^sub>E z]z])\<close>
    by (safe intro!: "eq-num:1"[unvarify G, THEN "\<equiv>E"(1)] "cqt:2")
  AOT_hence \<open>x = #[\<lambda>z O!z & z \<noteq>\<^sub>E z]\<close>
    by (safe intro!: "eq-num:2"[unvarify G, THEN "\<equiv>E"(1)] "cqt:2")
  AOT_thus \<open>x = 0\<close>
    using "cqt:2"(1) "rule-id-df:2:b[zero]" "rule=E" "zero:1" by blast
qed

AOT_define Numbers' :: \<open>\<tau> \<Rightarrow> \<tau> \<Rightarrow> \<phi>\<close> (\<open>Numbers'''(_,_')\<close>)
  \<open>Numbers'(x, G) \<equiv>\<^sub>d\<^sub>f A!x & G\<down> & \<forall>F (x[F] \<equiv> F \<approx>\<^sub>E G)\<close>
AOT_theorem Numbers'equiv: \<open>Numbers'(x,G) \<equiv> A!x & \<forall>F (x[F] \<equiv> F \<approx>\<^sub>E G)\<close>
  by (AOT_subst_def Numbers')
     (auto intro!: "\<equiv>I" "\<rightarrow>I" "&I" "cqt:2" dest: "&E")

AOT_theorem Numbers'DistinctZeroes:
  \<open>\<exists>x\<exists>y (\<diamond>Numbers'(x,[\<lambda>z O!z & z \<noteq>\<^sub>E z]) & \<diamond>Numbers'(y,[\<lambda>z O!z & z \<noteq>\<^sub>E z]) & x \<noteq> y)\<close>
proof -
  AOT_obtain w\<^sub>1 where \<open>\<exists>w w\<^sub>1 \<noteq> w\<close>
    using "two-worlds-exist:4" "PossibleWorld.\<exists>E"[rotated] by fast
  then AOT_obtain w\<^sub>2 where distinct_worlds: \<open>w\<^sub>1 \<noteq> w\<^sub>2\<close>
    using "PossibleWorld.\<exists>E"[rotated] by blast
  AOT_obtain x where x_prop:
    \<open>A!x & \<forall>F (x[F] \<equiv> w\<^sub>1 \<Turnstile> F \<approx>\<^sub>E [\<lambda>z O!z & z \<noteq>\<^sub>E z])\<close>
    using "A-objects"[axiom_inst] "\<exists>E"[rotated] by fast
  moreover AOT_obtain y where y_prop:
    \<open>A!y & \<forall>F (y[F] \<equiv> w\<^sub>2 \<Turnstile> F \<approx>\<^sub>E [\<lambda>z O!z & z \<noteq>\<^sub>E z])\<close>
    using "A-objects"[axiom_inst] "\<exists>E"[rotated] by fast
  moreover {
    fix x w
    AOT_assume x_prop: \<open>A!x & \<forall>F (x[F] \<equiv> w \<Turnstile> F \<approx>\<^sub>E [\<lambda>z O!z & z \<noteq>\<^sub>E z])\<close>
    AOT_have \<open>\<forall>F w \<Turnstile> (x[F] \<equiv> F \<approx>\<^sub>E [\<lambda>z O!z & z \<noteq>\<^sub>E z])\<close>
    proof(safe intro!: GEN "conj-dist-w:4"[unvarify p q, OF "log-prop-prop:2",
                              OF "log-prop-prop:2",THEN "\<equiv>E"(2)] "\<equiv>I" "\<rightarrow>I")
      fix F
      AOT_assume \<open>w \<Turnstile> x[F]\<close>
      AOT_hence \<open>\<diamond>x[F]\<close>
        using "fund:1"[unvarify p, OF "log-prop-prop:2", THEN "\<equiv>E"(2),
                       OF "PossibleWorld.\<exists>I"] by blast
      AOT_hence \<open>x[F]\<close>
        by (metis "en-eq:3[1]" "intro-elim:3:a")
      AOT_thus \<open>w \<Turnstile> (F \<approx>\<^sub>E [\<lambda>z O!z & z \<noteq>\<^sub>E z])\<close>
        using x_prop[THEN "&E"(2), THEN "\<forall>E"(2), THEN "\<equiv>E"(1)] by blast
    next
      fix F
      AOT_assume \<open>w \<Turnstile> (F \<approx>\<^sub>E [\<lambda>z O!z & z \<noteq>\<^sub>E z])\<close>
      AOT_hence \<open>x[F]\<close>
        using x_prop[THEN "&E"(2), THEN "\<forall>E"(2), THEN "\<equiv>E"(2)] by blast
      AOT_hence \<open>\<box>x[F]\<close>
        using "pre-en-eq:1[1]"[THEN "\<rightarrow>E"] by blast
      AOT_thus \<open>w \<Turnstile> x[F]\<close>
        using "fund:2"[unvarify p, OF "log-prop-prop:2", THEN "\<equiv>E"(1)]
              "PossibleWorld.\<forall>E" by fast
    qed
    AOT_hence \<open>w \<Turnstile> \<forall>F (x[F] \<equiv> F \<approx>\<^sub>E [\<lambda>z O!z & z \<noteq>\<^sub>E z])\<close>
      using "conj-dist-w:5"[THEN "\<equiv>E"(2)] by fast
    moreover {
      AOT_have \<open>\<box>[\<lambda>z O!z & z \<noteq>\<^sub>E z]\<down>\<close>
        by (safe intro!: RN "cqt:2")
      AOT_hence \<open>w \<Turnstile> [\<lambda>z O!z & z \<noteq>\<^sub>E z]\<down>\<close>
        using "fund:2"[unvarify p, OF "log-prop-prop:2", THEN "\<equiv>E"(1),
                       THEN "PossibleWorld.\<forall>E"] by blast
    }
    moreover {
      AOT_have \<open>\<box>A!x\<close>
        using x_prop[THEN "&E"(1)] by (metis "oa-facts:2" "\<rightarrow>E")
      AOT_hence \<open>w \<Turnstile> A!x\<close>
        using "fund:2"[unvarify p, OF "log-prop-prop:2",
                       THEN "\<equiv>E"(1), THEN "PossibleWorld.\<forall>E"] by blast
    }
    ultimately AOT_have \<open>w \<Turnstile> (A!x & [\<lambda>z O!z & z \<noteq>\<^sub>E z]\<down> &
                               \<forall>F (x[F] \<equiv> F \<approx>\<^sub>E [\<lambda>z O!z & z \<noteq>\<^sub>E z]))\<close>
      using "conj-dist-w:1"[unvarify p q, OF "log-prop-prop:2",
              OF "log-prop-prop:2", THEN "\<equiv>E"(2), OF "&I"] by auto
    AOT_hence \<open>\<exists>w w \<Turnstile> (A!x & [\<lambda>z O!z & z \<noteq>\<^sub>E z]\<down> &
                        \<forall>F (x[F] \<equiv> F \<approx>\<^sub>E [\<lambda>z O!z & z \<noteq>\<^sub>E z]))\<close>
      using "PossibleWorld.\<exists>I" by auto
    AOT_hence \<open>\<diamond>(A!x & [\<lambda>z O!z & z \<noteq>\<^sub>E z]\<down> & \<forall>F (x[F] \<equiv> F \<approx>\<^sub>E [\<lambda>z O!z & z \<noteq>\<^sub>E z]))\<close>
      using "fund:1"[unvarify p, OF "log-prop-prop:2", THEN "\<equiv>E"(2)] by blast
    AOT_hence \<open>\<diamond>Numbers'(x,[\<lambda>z O!z & z \<noteq>\<^sub>E z])\<close>
      by (AOT_subst_def Numbers')
  }
  ultimately AOT_have \<open>\<diamond>Numbers'(x,[\<lambda>z O!z & z \<noteq>\<^sub>E z])\<close>
                  and \<open>\<diamond>Numbers'(y,[\<lambda>z O!z & z \<noteq>\<^sub>E z])\<close>
    by auto
  moreover AOT_have \<open>x \<noteq> y\<close>
  proof (rule "ab-obey:2"[THEN "\<rightarrow>E"])
    AOT_have \<open>\<box>\<not>\<exists>u [\<lambda>z O!z & z \<noteq>\<^sub>E z]u\<close>
    proof (safe intro!: RN "raa-cor:2")
      AOT_modally_strict {
        AOT_assume \<open>\<exists>u [\<lambda>z O!z & z \<noteq>\<^sub>E z]u\<close>
        then AOT_obtain u where \<open>[\<lambda>z O!z & z \<noteq>\<^sub>E z]u\<close>
          using "Ordinary.\<exists>E"[rotated] by blast
        AOT_hence \<open>O!u & u \<noteq>\<^sub>E u\<close>
          by (rule "\<beta>\<rightarrow>C")
        AOT_hence \<open>\<not>(u =\<^sub>E u)\<close>
          by (metis "con-dis-taut:2" "intro-elim:3:d" "modus-tollens:1"
                    "raa-cor:3" "thm-neg=E")
        AOT_hence \<open>u =\<^sub>E u & \<not>u =\<^sub>E u\<close>
          by (metis "modus-tollens:1" "ord=Eequiv:1" "raa-cor:3" Ordinary.\<psi>)
        AOT_thus \<open>p & \<not>p\<close> for p
          by (metis "raa-cor:1")
      }
    qed
    AOT_hence nec_not_ex: \<open>\<forall>w w \<Turnstile> \<not>\<exists>u [\<lambda>z O!z & z \<noteq>\<^sub>E z]u\<close>
      using "fund:2"[unvarify p, OF "log-prop-prop:2", THEN "\<equiv>E"(1)] by blast
    AOT_have \<open>\<box>([\<lambda>y p]x \<equiv> p)\<close> for x p
      by (safe intro!: RN "beta-C-meta"[THEN "\<rightarrow>E"] "cqt:2")
    AOT_hence \<open>\<forall>w w \<Turnstile> ([\<lambda>y p]x \<equiv> p)\<close> for x p
      using "fund:2"[unvarify p, OF "log-prop-prop:2", THEN "\<equiv>E"(1)] by blast
    AOT_hence world_prop_beta: \<open>\<forall>w (w \<Turnstile> [\<lambda>y p]x \<equiv> w \<Turnstile> p)\<close> for x p
      using "conj-dist-w:4"[unvarify p, OF "log-prop-prop:2", THEN "\<equiv>E"(1)]
            "PossibleWorld.\<forall>E" "PossibleWorld.\<forall>I" by meson

    AOT_have \<open>\<exists>p (w\<^sub>1 \<Turnstile> p & \<not>w\<^sub>2 \<Turnstile> p)\<close>
    proof(rule "raa-cor:1")
      AOT_assume 0: \<open>\<not>\<exists>p (w\<^sub>1 \<Turnstile> p & \<not>w\<^sub>2 \<Turnstile> p)\<close>
      AOT_have 1: \<open>w\<^sub>1 \<Turnstile> p \<rightarrow> w\<^sub>2 \<Turnstile> p\<close> for p
      proof(safe intro!: GEN "\<rightarrow>I")
        AOT_assume \<open>w\<^sub>1 \<Turnstile> p\<close>
        AOT_thus \<open>w\<^sub>2 \<Turnstile> p\<close>
          using 0 "con-dis-i-e:1" "\<exists>I"(2) "raa-cor:4" by fast
      qed
      moreover AOT_have \<open>w\<^sub>2 \<Turnstile> p \<rightarrow> w\<^sub>1 \<Turnstile> p\<close> for p
      proof(safe intro!: GEN "\<rightarrow>I")
        AOT_assume \<open>w\<^sub>2 \<Turnstile> p\<close>
        AOT_hence \<open>\<not>w\<^sub>2 \<Turnstile> \<not>p\<close>
          using "coherent:2" "intro-elim:3:a" by blast
        AOT_hence \<open>\<not>w\<^sub>1 \<Turnstile> \<not>p\<close>
          using 1["\<forall>I" p, THEN "\<forall>E"(1), OF "log-prop-prop:2"]
          by (metis "modus-tollens:1")
        AOT_thus \<open>w\<^sub>1 \<Turnstile> p\<close>
          using "coherent:1" "intro-elim:3:b" "reductio-aa:1" by blast
      qed
      ultimately AOT_have \<open>w\<^sub>1 \<Turnstile> p \<equiv> w\<^sub>2 \<Turnstile> p\<close> for p
        by (metis "intro-elim:2")
      AOT_hence \<open>w\<^sub>1 = w\<^sub>2\<close>
        using "sit-identity"[unconstrain s, THEN "\<rightarrow>E",
            OF PossibleWorld.\<psi>[THEN "world:1"[THEN "\<equiv>\<^sub>d\<^sub>fE"], THEN "&E"(1)],
            unconstrain s', THEN "\<rightarrow>E",
            OF PossibleWorld.\<psi>[THEN "world:1"[THEN "\<equiv>\<^sub>d\<^sub>fE"], THEN "&E"(1)],
            THEN "\<equiv>E"(2)] GEN by fast
      AOT_thus \<open>w\<^sub>1 = w\<^sub>2 & \<not>w\<^sub>1 = w\<^sub>2\<close>
        using  "=-infix" "\<equiv>\<^sub>d\<^sub>fE" "con-dis-i-e:1" distinct_worlds by blast
    qed
    then AOT_obtain p where 0: \<open>w\<^sub>1 \<Turnstile> p & \<not>w\<^sub>2 \<Turnstile> p\<close>
      using "\<exists>E"[rotated] by blast
    AOT_have \<open>y[\<lambda>y p]\<close>
    proof (safe intro!: y_prop[THEN "&E"(2), THEN "\<forall>E"(1), THEN "\<equiv>E"(2)] "cqt:2")
      AOT_show \<open>w\<^sub>2 \<Turnstile> [\<lambda>y p] \<approx>\<^sub>E [\<lambda>z O!z & z \<noteq>\<^sub>E z]\<close>
      proof (safe intro!:  "cqt:2" "empty-approx:1"[unvarify F H, THEN RN,
                  THEN "fund:2"[unvarify p, OF "log-prop-prop:2", THEN "\<equiv>E"(1)],
                  THEN "PossibleWorld.\<forall>E",
                  THEN "conj-dist-w:2"[unvarify p q, OF "log-prop-prop:2",
                                       OF "log-prop-prop:2", THEN "\<equiv>E"(1)],
                                       THEN "\<rightarrow>E"]
                  "conj-dist-w:1"[unvarify p q, OF "log-prop-prop:2",
                                  OF "log-prop-prop:2", THEN "\<equiv>E"(2)] "&I")
        AOT_have \<open>\<not>w\<^sub>2 \<Turnstile> \<exists>u [\<lambda>y p]u\<close>
        proof (rule "raa-cor:2")
          AOT_assume \<open>w\<^sub>2 \<Turnstile> \<exists>u [\<lambda>y p]u\<close>
          AOT_hence \<open>\<exists>x w\<^sub>2 \<Turnstile> (O!x & [\<lambda>y p]x)\<close>
            by (metis "conj-dist-w:6" "intro-elim:3:a")
          then AOT_obtain x where \<open>w\<^sub>2 \<Turnstile> (O!x & [\<lambda>y p]x)\<close>
            using "\<exists>E"[rotated] by blast
          AOT_hence \<open>w\<^sub>2 \<Turnstile> [\<lambda>y p]x\<close>
            using "conj-dist-w:1"[unvarify p q, OF "log-prop-prop:2",
                    OF "log-prop-prop:2", THEN "\<equiv>E"(1), THEN "&E"(2)] by blast
          AOT_hence \<open>w\<^sub>2 \<Turnstile> p\<close>
            using world_prop_beta[THEN "PossibleWorld.\<forall>E", THEN "\<equiv>E"(1)] by blast
          AOT_thus \<open>w\<^sub>2 \<Turnstile> p & \<not>w\<^sub>2 \<Turnstile> p\<close>
            using 0[THEN "&E"(2)] "&I" by blast
        qed
        AOT_thus \<open>w\<^sub>2 \<Turnstile> \<not>\<exists>u [\<lambda>y p]u\<close>
          by (safe intro!: "coherent:1"[unvarify p, OF "log-prop-prop:2",
                                        THEN "\<equiv>E"(2)])
      next
        AOT_show \<open>w\<^sub>2 \<Turnstile> \<not>\<exists>v [\<lambda>z O!z & z \<noteq>\<^sub>E z]v\<close>
          using nec_not_ex[THEN "PossibleWorld.\<forall>E"] by blast
      qed
    qed
    moreover AOT_have \<open>\<not>x[\<lambda>y p]\<close>
    proof(rule "raa-cor:2")
      AOT_assume \<open>x[\<lambda>y p]\<close>
      AOT_hence "w\<^sub>1 \<Turnstile> [\<lambda>y p] \<approx>\<^sub>E [\<lambda>z O!z & z \<noteq>\<^sub>E z]"
        using x_prop[THEN "&E"(2), THEN "\<forall>E"(1), THEN "\<equiv>E"(1)]
              "prop-prop2:2" by blast
      AOT_hence "\<not>w\<^sub>1 \<Turnstile> \<not>[\<lambda>y p] \<approx>\<^sub>E [\<lambda>z O!z & z \<noteq>\<^sub>E z]"
        using "coherent:2"[unvarify p, OF "log-prop-prop:2", THEN "\<equiv>E"(1)] by blast
      moreover AOT_have "w\<^sub>1 \<Turnstile> \<not>([\<lambda>y p] \<approx>\<^sub>E [\<lambda>z O!z & z \<noteq>\<^sub>E z])"
      proof (safe intro!: "cqt:2" "empty-approx:2"[unvarify F H, THEN RN,
                    THEN "fund:2"[unvarify p, OF "log-prop-prop:2", THEN "\<equiv>E"(1)],
                    THEN "PossibleWorld.\<forall>E",
                    THEN "conj-dist-w:2"[unvarify p q, OF "log-prop-prop:2",
                        OF "log-prop-prop:2", THEN "\<equiv>E"(1)], THEN "\<rightarrow>E"]
                    "conj-dist-w:1"[unvarify p q, OF "log-prop-prop:2",
                                    OF "log-prop-prop:2", THEN "\<equiv>E"(2)] "&I")
        fix u
        AOT_have \<open>w\<^sub>1 \<Turnstile> O!u\<close>
          using Ordinary.\<psi>[THEN RN,
                  THEN "fund:2"[unvarify p, OF "log-prop-prop:2", THEN "\<equiv>E"(1)],
                  THEN "PossibleWorld.\<forall>E"] by simp
        moreover AOT_have \<open>w\<^sub>1 \<Turnstile> [\<lambda>y p]u\<close>
          by (safe intro!: world_prop_beta[THEN "PossibleWorld.\<forall>E", THEN "\<equiv>E"(2)]
                           0[THEN "&E"(1)])
        ultimately AOT_have \<open>w\<^sub>1 \<Turnstile> (O!u & [\<lambda>y p]u)\<close>
          using "conj-dist-w:1"[unvarify p q, OF "log-prop-prop:2",
                                OF "log-prop-prop:2", THEN "\<equiv>E"(2),
                                OF "&I"] by blast
        AOT_hence \<open>\<exists>x w\<^sub>1 \<Turnstile> (O!x & [\<lambda>y p]x)\<close>
          by (rule "\<exists>I")
        AOT_thus \<open>w\<^sub>1 \<Turnstile> \<exists>u [\<lambda>y p]u\<close>
          by (metis "conj-dist-w:6" "intro-elim:3:b")
      next
        AOT_show \<open>w\<^sub>1 \<Turnstile> \<not>\<exists>v [\<lambda>z O!z & z \<noteq>\<^sub>E z]v\<close>
          using "PossibleWorld.\<forall>E" nec_not_ex by fastforce
      qed
      ultimately AOT_show \<open>p & \<not>p\<close> for p
        using "raa-cor:3" by blast
    qed
    ultimately AOT_have \<open>y[\<lambda>y p] & \<not>x[\<lambda>y p]\<close>
      using "&I" by blast
    AOT_hence \<open>\<exists>F (y[F] & \<not>x[F])\<close>
      by (metis "existential:1" "prop-prop2:2")
    AOT_thus \<open>\<exists>F (x[F] & \<not>y[F]) \<or> \<exists>F (y[F] & \<not>x[F])\<close>
      by (rule "\<or>I")
  qed
  ultimately AOT_have \<open>\<diamond>Numbers'(x,[\<lambda>z O!z & z \<noteq>\<^sub>E z]) &
                       \<diamond>Numbers'(y,[\<lambda>z O!z & z \<noteq>\<^sub>E z]) & x \<noteq> y\<close>
    using "&I" by blast
  AOT_thus \<open>\<exists>x\<exists>y (\<diamond>Numbers'(x,[\<lambda>z O!z & z \<noteq>\<^sub>E z]) &
                  \<diamond>Numbers'(y,[\<lambda>z O!z & z \<noteq>\<^sub>E z]) & x \<noteq> y)\<close>
    using "\<exists>I"(2)[where \<beta>=x] "\<exists>I"(2)[where \<beta>=y] by auto
qed

AOT_theorem restricted_identity:
  \<open>x =\<^sub>\<R> y \<equiv> (InDomainOf(x,\<R>) & InDomainOf(y,\<R>) & x = y)\<close>
  by (auto intro!: "\<equiv>I" "\<rightarrow>I" "&I"
             dest: "id-R-thm:2"[THEN "\<rightarrow>E"] "&E"
                   "id-R-thm:3"[THEN "\<rightarrow>E"]
                   "id-R-thm:4"[THEN "\<rightarrow>E", OF "\<or>I"(1), THEN "\<equiv>E"(2)])

AOT_theorem induction': \<open>\<forall>F ([F]0 & \<forall>n([F]n \<rightarrow> [F]n\<^bold>') \<rightarrow> \<forall>n [F]n)\<close>
proof(rule GEN; rule "\<rightarrow>I")
  fix F n
  AOT_assume A: \<open>[F]0 & \<forall>n([F]n \<rightarrow> [F]n\<^bold>')\<close>
  AOT_have \<open>\<forall>n\<forall>m([\<bbbP>]nm \<rightarrow> ([F]n \<rightarrow> [F]m))\<close>
  proof(safe intro!: "Number.GEN" "\<rightarrow>I")
    fix n m
    AOT_assume \<open>[\<bbbP>]nm\<close>
    moreover AOT_have \<open>[\<bbbP>]n n\<^bold>'\<close>
      using "suc-thm".
    ultimately AOT_have m_eq_suc_n: \<open>m = n\<^bold>'\<close>
      using "pred-func:1"[unvarify z, OF "def-suc[den2]", THEN "\<rightarrow>E", OF "&I"]
      by blast
    AOT_assume \<open>[F]n\<close>
    AOT_hence \<open>[F]n\<^bold>'\<close>
      using A[THEN "&E"(2), THEN "Number.\<forall>E", THEN "\<rightarrow>E"] by blast
    AOT_thus \<open>[F]m\<close>
      using m_eq_suc_n[symmetric] "rule=E" by fast
  qed
  AOT_thus \<open>\<forall>n[F]n\<close>
    using induction[THEN "\<forall>E"(2), THEN "\<rightarrow>E", OF "&I", OF A[THEN "&E"(1)]]
    by simp
qed

AOT_define ExtensionOf :: \<open>\<tau> \<Rightarrow> \<Pi> \<Rightarrow> \<phi>\<close> (\<open>ExtensionOf'(_,_')\<close>)
  "exten-property:1": \<open>ExtensionOf(x,[G]) \<equiv>\<^sub>d\<^sub>f A!x & G\<down> & \<forall>F(x[F] \<equiv> \<forall>z([F]z \<equiv> [G]z))\<close>

AOT_define OrdinaryExtensionOf :: \<open>\<tau> \<Rightarrow> \<Pi> \<Rightarrow> \<phi>\<close> (\<open>OrdinaryExtensionOf'(_,_')\<close>)
   \<open>OrdinaryExtensionOf(x,[G]) \<equiv>\<^sub>d\<^sub>f A!x & G\<down> & \<forall>F(x[F] \<equiv> \<forall>z(O!z \<rightarrow> ([F]z \<equiv> [G]z)))\<close>

AOT_theorem BeingOrdinaryExtensionOfDenotes:
  \<open>[\<lambda>x OrdinaryExtensionOf(x,[G])]\<down>\<close>
proof(rule "safe-ext"[axiom_inst, THEN "\<rightarrow>E", OF "&I"])
  AOT_show \<open>[\<lambda>x A!x & G\<down> & [\<lambda>x \<forall>F(x[F] \<equiv> \<forall>z(O!z \<rightarrow> ([F]z \<equiv> [G]z)))]x]\<down>\<close>
    by "cqt:2"
next
  AOT_show \<open>\<box>\<forall>x (A!x & G\<down> & [\<lambda>x \<forall>F (x[F] \<equiv> \<forall>z (O!z \<rightarrow> ([F]z \<equiv> [G]z)))]x \<equiv>
            OrdinaryExtensionOf(x,[G]))\<close>
  proof(safe intro!: RN GEN)
    AOT_modally_strict {
      fix x
      AOT_modally_strict {
        AOT_have \<open>[\<lambda>x \<forall>F (x[F] \<equiv> \<forall>z (O!z \<rightarrow> ([F]z \<equiv> [G]z)))]\<down>\<close>
        proof (safe intro!: "Comprehension_3"[THEN "\<rightarrow>E"] RN GEN
                            "\<rightarrow>I" "\<equiv>I" Ordinary.GEN)
          AOT_modally_strict {
            fix F H u
            AOT_assume \<open>\<box>H \<equiv>\<^sub>E F\<close>
            AOT_hence \<open>\<forall>u([H]u \<equiv> [F]u)\<close>
              using eqE[THEN "\<equiv>\<^sub>d\<^sub>fE", THEN "&E"(2)] "qml:2"[axiom_inst, THEN "\<rightarrow>E"]
              by blast
            AOT_hence 0: \<open>[H]u \<equiv> [F]u\<close> using "Ordinary.\<forall>E" by fast
            {
              AOT_assume \<open>\<forall>u([F]u \<equiv> [G]u)\<close>
              AOT_hence 1: \<open>[F]u \<equiv> [G]u\<close> using "Ordinary.\<forall>E" by fast
              AOT_show \<open>[G]u\<close> if \<open>[H]u\<close> using 0 1 "\<equiv>E"(1) that by blast
              AOT_show \<open>[H]u\<close> if \<open>[G]u\<close> using 0 1 "\<equiv>E"(2) that by blast
            }
            {
              AOT_assume \<open>\<forall>u([H]u \<equiv> [G]u)\<close>
              AOT_hence 1: \<open>[H]u \<equiv> [G]u\<close> using "Ordinary.\<forall>E" by fast
              AOT_show \<open>[G]u\<close> if \<open>[F]u\<close> using 0 1 "\<equiv>E"(1,2) that by blast
              AOT_show \<open>[F]u\<close> if \<open>[G]u\<close> using 0 1 "\<equiv>E"(1,2) that by blast
            }
          }
        qed
      }
      AOT_thus \<open>(A!x & G\<down> & [\<lambda>x \<forall>F (x[F] \<equiv> \<forall>z (O!z \<rightarrow> ([F]z \<equiv> [G]z)))]x) \<equiv>
                OrdinaryExtensionOf(x,[G])\<close>
        apply (AOT_subst_def OrdinaryExtensionOf)
        apply (AOT_subst \<open>[\<lambda>x \<forall>F (x[F] \<equiv> \<forall>z (O!z \<rightarrow> ([F]z \<equiv> [G]z)))]x\<close>
                         \<open>\<forall>F (x[F] \<equiv> \<forall>z (O!z \<rightarrow> ([F]z \<equiv> [G]z)))\<close>)
        by (auto intro!: "beta-C-meta"[THEN "\<rightarrow>E"] simp: "oth-class-taut:3:a")
    }
  qed
qed

text\<open>Fragments of PLM's theory of Concepts.\<close>

AOT_define FimpG :: \<open>\<Pi> \<Rightarrow> \<Pi> \<Rightarrow> \<phi>\<close> (infixl \<open>\<Rightarrow>\<close> 50)
  "F-imp-G": \<open>[G] \<Rightarrow> [F] \<equiv>\<^sub>d\<^sub>f F\<down> & G\<down> & \<box>\<forall>x ([G]x \<rightarrow> [F]x)\<close>

AOT_define concept :: \<open>\<Pi>\<close> (\<open>C!\<close>)
  concepts: \<open>C! =\<^sub>d\<^sub>f A!\<close>

AOT_register_rigid_restricted_type
  Concept: \<open>C!\<kappa>\<close>
proof
  AOT_modally_strict {
    AOT_have \<open>\<exists>x A!x\<close>
      using "o-objects-exist:2" "qml:2"[axiom_inst] "\<rightarrow>E" by blast
    AOT_thus \<open>\<exists>x C!x\<close>
      using "rule-id-df:1[zero]"[OF concepts, OF "oa-exist:2"] "rule=E" id_sym
      by fast
  }
next
  AOT_modally_strict {
    AOT_show \<open>C!\<kappa> \<rightarrow> \<kappa>\<down>\<close> for \<kappa>
      using "cqt:5:a"[axiom_inst, THEN "\<rightarrow>E", THEN "&E"(2)] "\<rightarrow>I"
      by blast
  }
next
  AOT_modally_strict {
    AOT_have \<open>\<forall>x(A!x \<rightarrow> \<box>A!x)\<close>
      by (simp add: "oa-facts:2" GEN)
    AOT_thus \<open>\<forall>x(C!x \<rightarrow> \<box>C!x)\<close>
      using "rule-id-df:1[zero]"[OF concepts, OF "oa-exist:2"] "rule=E" id_sym
      by fast
  }
qed

AOT_register_variable_names
  Concept: c d e

AOT_theorem "concept-comp:1": \<open>\<exists>x(C!x & \<forall>F(x[F] \<equiv> \<phi>{F}))\<close>
    using concepts[THEN "rule-id-df:1[zero]", OF "oa-exist:2", symmetric]
          "A-objects"[axiom_inst]
          "rule=E" by fast

AOT_theorem "concept-comp:2": \<open>\<exists>!x(C!x & \<forall>F(x[F] \<equiv> \<phi>{F}))\<close>
    using concepts[THEN "rule-id-df:1[zero]", OF "oa-exist:2", symmetric]
          "A-objects!"
          "rule=E" by fast

AOT_theorem "concept-comp:3": \<open>\<^bold>\<iota>x(C!x & \<forall>F(x[F] \<equiv> \<phi>{F}))\<down>\<close>
  using "concept-comp:2" "A-Exists:2"[THEN "\<equiv>E"(2)] "RA[2]" by blast

AOT_theorem "concept-comp:4":
  \<open>\<^bold>\<iota>x(C!x & \<forall>F(x[F] \<equiv> \<phi>{F})) = \<^bold>\<iota>x(A!x & \<forall>F(x[F] \<equiv> \<phi>{F}))\<close>
    using "=I"(1)[OF "concept-comp:3"]
          "rule=E"[rotated]
          concepts[THEN "rule-id-df:1[zero]", OF "oa-exist:2"]
          by fast

AOT_define conceptInclusion :: \<open>\<tau> \<Rightarrow> \<tau> \<Rightarrow> \<phi>\<close> (infixl \<open>\<preceq>\<close> 100)
  "con:1": \<open>c \<preceq> d \<equiv>\<^sub>d\<^sub>f \<forall>F(c[F] \<rightarrow> d[F])\<close>

AOT_define conceptOf :: \<open>\<tau> \<Rightarrow> \<tau> \<Rightarrow> \<phi>\<close> (\<open>ConceptOf'(_,_')\<close>)
  "concept-of-G": \<open>ConceptOf(c,G) \<equiv>\<^sub>d\<^sub>f G\<down> & \<forall>F (c[F] \<equiv> [G] \<Rightarrow> [F])\<close>

AOT_theorem ConceptOfOrdinaryProperty: \<open>([H] \<Rightarrow> O!) \<rightarrow> [\<lambda>x ConceptOf(x,H)]\<down>\<close>
proof(rule "\<rightarrow>I")
  AOT_assume \<open>[H] \<Rightarrow> O!\<close>
  AOT_hence \<open>\<box>\<forall>x([H]x \<rightarrow> O!x)\<close>
    using "F-imp-G"[THEN "\<equiv>\<^sub>d\<^sub>fE"] "&E" by blast
  AOT_hence \<open>\<box>\<box>\<forall>x([H]x \<rightarrow> O!x)\<close>
    using "S5Basic:6"[THEN "\<equiv>E"(1)] by blast
  moreover AOT_have \<open>\<box>\<box>\<forall>x([H]x \<rightarrow> O!x) \<rightarrow>
                     \<box>\<forall>F\<forall>G(\<box>(G \<equiv>\<^sub>E F) \<rightarrow> ([H] \<Rightarrow> [F] \<equiv> [H] \<Rightarrow> [G]))\<close>
  proof(rule RM; safe intro!: "\<rightarrow>I" GEN "\<equiv>I")
    AOT_modally_strict {
      fix F G
      AOT_assume 0: \<open>\<box>\<forall>x([H]x \<rightarrow> O!x)\<close>
      AOT_assume \<open>\<box>G \<equiv>\<^sub>E F\<close>
      AOT_hence 1: \<open>\<box>\<forall>u([G]u \<equiv> [F]u)\<close>
        by (AOT_subst_thm eqE[THEN "\<equiv>Df", THEN "\<equiv>S"(1), OF "&I",
              OF "cqt:2[const_var]"[axiom_inst],
              OF "cqt:2[const_var]"[axiom_inst], symmetric])
      {
        AOT_assume \<open>[H] \<Rightarrow> [F]\<close>
        AOT_hence \<open>\<box>\<forall>x([H]x \<rightarrow> [F]x)\<close>
          using "F-imp-G"[THEN "\<equiv>\<^sub>d\<^sub>fE"] "&E" by blast
        moreover AOT_modally_strict {
          AOT_assume \<open>\<forall>x([H]x \<rightarrow> O!x)\<close>
          moreover AOT_assume \<open>\<forall>u([G]u \<equiv> [F]u)\<close>
          moreover AOT_assume \<open>\<forall>x([H]x \<rightarrow> [F]x)\<close>
          ultimately AOT_have \<open>[H]x \<rightarrow> [G]x\<close> for x
            by (auto intro!: "\<rightarrow>I" dest!: "\<forall>E"(2) dest: "\<rightarrow>E" "\<equiv>E")
          AOT_hence \<open>\<forall>x([H]x \<rightarrow> [G]x)\<close>
            by (rule GEN)
        }
        ultimately AOT_have \<open>\<box>\<forall>x([H]x \<rightarrow> [G]x)\<close>
          using "RN[prem]"[where
              \<Gamma>="{\<guillemotleft>\<forall>x([H]x \<rightarrow> O!x)\<guillemotright>, \<guillemotleft>\<forall>u([G]u \<equiv> [F]u)\<guillemotright>, \<guillemotleft>\<forall>x([H]x \<rightarrow> [F]x)\<guillemotright>}"]
          using 0 1 by fast
        AOT_thus \<open>[H] \<Rightarrow> [G]\<close>
          by (AOT_subst_def "F-imp-G")
             (safe intro!: "cqt:2" "&I")
      }
      {
        AOT_assume \<open>[H] \<Rightarrow> [G]\<close>
        AOT_hence \<open>\<box>\<forall>x([H]x \<rightarrow> [G]x)\<close>
          using "F-imp-G"[THEN "\<equiv>\<^sub>d\<^sub>fE"] "&E" by blast
        moreover AOT_modally_strict {
          AOT_assume \<open>\<forall>x([H]x \<rightarrow> O!x)\<close>
          moreover AOT_assume \<open>\<forall>u([G]u \<equiv> [F]u)\<close>
          moreover AOT_assume \<open>\<forall>x([H]x \<rightarrow> [G]x)\<close>
          ultimately AOT_have \<open>[H]x \<rightarrow> [F]x\<close> for x
            by (auto intro!: "\<rightarrow>I" dest!: "\<forall>E"(2) dest: "\<rightarrow>E" "\<equiv>E")
          AOT_hence \<open>\<forall>x([H]x \<rightarrow> [F]x)\<close>
            by (rule GEN)
        }
        ultimately AOT_have \<open>\<box>\<forall>x([H]x \<rightarrow> [F]x)\<close>
          using "RN[prem]"[where
              \<Gamma>="{\<guillemotleft>\<forall>x([H]x \<rightarrow> O!x)\<guillemotright>, \<guillemotleft>\<forall>u([G]u \<equiv> [F]u)\<guillemotright>, \<guillemotleft>\<forall>x([H]x \<rightarrow> [G]x)\<guillemotright>}"]
          using 0 1 by fast
        AOT_thus \<open>[H] \<Rightarrow> [F]\<close>
          by (AOT_subst_def "F-imp-G")
             (safe intro!: "cqt:2" "&I")
      }
    }
  qed
  ultimately AOT_have \<open>\<box>\<forall>F\<forall>G(\<box>(G \<equiv>\<^sub>E F) \<rightarrow> ([H] \<Rightarrow> [F] \<equiv> [H] \<Rightarrow> [G]))\<close>
    using "\<rightarrow>E" by blast
  AOT_hence 0: \<open>[\<lambda>x \<forall>F(x[F] \<equiv> ([H] \<Rightarrow> [F]))]\<down>\<close>
    using Comprehension_3[THEN "\<rightarrow>E"] by blast
  AOT_show \<open>[\<lambda>x ConceptOf(x,H)]\<down>\<close>
  proof (rule "safe-ext"[axiom_inst, THEN "\<rightarrow>E", OF "&I"])
    AOT_show \<open>[\<lambda>x C!x & [\<lambda>x \<forall>F(x[F] \<equiv> ([H] \<Rightarrow> [F]))]x]\<down>\<close> by "cqt:2"
  next
    AOT_show \<open>\<box>\<forall>x (C!x & [\<lambda>x \<forall>F (x[F] \<equiv> [H] \<Rightarrow> [F])]x \<equiv> ConceptOf(x,H))\<close>
    proof (rule "RN[prem]"[where \<Gamma>=\<open>{\<guillemotleft>[\<lambda>x \<forall>F(x[F] \<equiv> ([H] \<Rightarrow> [F]))]\<down>\<guillemotright>}\<close>, simplified])
      AOT_modally_strict {
        AOT_assume 0: \<open>[\<lambda>x \<forall>F (x[F] \<equiv> [H] \<Rightarrow> [F])]\<down>\<close>
        AOT_show \<open>\<forall>x (C!x & [\<lambda>x \<forall>F (x[F] \<equiv> [H] \<Rightarrow> [F])]x \<equiv> ConceptOf(x,H))\<close>
        proof(safe intro!: GEN "\<equiv>I" "\<rightarrow>I" "&I")
          fix x
          AOT_assume \<open>C!x & [\<lambda>x \<forall>F (x[F] \<equiv> [H] \<Rightarrow> [F])]x\<close>
          AOT_thus \<open>ConceptOf(x,H)\<close>
            by (AOT_subst_def "concept-of-G")
               (auto intro!: "&I" "cqt:2" dest: "&E" "\<beta>\<rightarrow>C")
        next
          fix x
          AOT_assume \<open>ConceptOf(x,H)\<close>
          AOT_hence \<open>C!x & (H\<down> & \<forall>F(x[F] \<equiv> [H] \<Rightarrow> [F]))\<close>
            by (AOT_subst_def (reverse) "concept-of-G")
          AOT_thus \<open>C!x\<close> and \<open>[\<lambda>x \<forall>F(x[F] \<equiv> [H] \<Rightarrow> [F])]x\<close>
            by (auto intro!: "\<beta>\<leftarrow>C" 0 "cqt:2" dest: "&E")
        qed
      }
    next
      AOT_show \<open>\<box>[\<lambda>x \<forall>F(x[F] \<equiv> ([H] \<Rightarrow> [F]))]\<down>\<close>
        using "exist-nec"[THEN "\<rightarrow>E"] 0 by blast
    qed
  qed
qed

AOT_theorem "con-exists:1": \<open>\<exists>c ConceptOf(c,G)\<close>
proof -
  AOT_obtain c where \<open>\<forall>F (c[F] \<equiv> [G] \<Rightarrow> [F])\<close>
    using "concept-comp:1" "Concept.\<exists>E"[rotated] by meson
  AOT_hence \<open>ConceptOf(c,G)\<close>
    by (auto intro!: "concept-of-G"[THEN "\<equiv>\<^sub>d\<^sub>fI"] "&I" "cqt:2" Concept.\<psi>)
  thus ?thesis by (rule "Concept.\<exists>I")
qed

AOT_theorem "con-exists:2": \<open>\<exists>!c ConceptOf(c,G)\<close>
proof -
  AOT_have \<open>\<exists>!c \<forall>F (c[F] \<equiv> [G] \<Rightarrow> [F])\<close>
    using "concept-comp:2" by simp
  moreover {
    AOT_modally_strict {
      fix x
      AOT_assume \<open>\<forall>F (x[F] \<equiv> [G] \<Rightarrow> [F])\<close>
      moreover AOT_have \<open>[G] \<Rightarrow> [G]\<close>
        by (safe intro!: "F-imp-G"[THEN "\<equiv>\<^sub>d\<^sub>fI"] "&I" "cqt:2" RN GEN "\<rightarrow>I")
      ultimately AOT_have \<open>x[G]\<close>
        using "\<forall>E"(2) "\<equiv>E" by blast
      AOT_hence \<open>A!x\<close>
        using "encoders-are-abstract"[THEN "\<rightarrow>E", OF "\<exists>I"(2)] by simp
      AOT_hence \<open>C!x\<close>
        using concepts[THEN "rule-id-df:1[zero]", OF "oa-exist:2", symmetric]
              "rule=E"[rotated]
        by fast
    }
  }
  ultimately show ?thesis
    by (AOT_subst \<open>ConceptOf(c,G)\<close> \<open>\<forall>F (c[F] \<equiv> [G] \<Rightarrow> [F])\<close> for: c;
           AOT_subst_def "concept-of-G")
       (auto intro!: "\<equiv>I" "\<rightarrow>I" "&I" "cqt:2" Concept.\<psi> dest: "&E")
qed

AOT_theorem "con-exists:3": \<open>\<^bold>\<iota>c ConceptOf(c,G)\<down>\<close>
  by (safe intro!: "A-Exists:2"[THEN "\<equiv>E"(2)] "con-exists:2"[THEN "RA[2]"])

AOT_define theConceptOfG :: \<open>\<tau> \<Rightarrow> \<kappa>\<^sub>s\<close> (\<open>\<^bold>c\<^sub>_\<close>)
  "concept-G": \<open>\<^bold>c\<^sub>G =\<^sub>d\<^sub>f \<^bold>\<iota>c ConceptOf(c, G)\<close>

AOT_theorem "concept-G[den]": \<open>\<^bold>c\<^sub>G\<down>\<close>
  by (auto intro!: "rule-id-df:1"[OF "concept-G"]
                   "t=t-proper:1"[THEN "\<rightarrow>E"]
                   "con-exists:3")

AOT_theorem "concept-G[concept]": \<open>C!\<^bold>c\<^sub>G\<close>
proof -
  AOT_have \<open>\<^bold>\<A>(C!\<^bold>c\<^sub>G & ConceptOf(\<^bold>c\<^sub>G, G))\<close>
    by (auto intro!: "actual-desc:2"[unvarify x, THEN "\<rightarrow>E"]
                     "rule-id-df:1"[OF "concept-G"]
                     "concept-G[den]"
                     "con-exists:3")
  AOT_hence \<open>\<^bold>\<A>C!\<^bold>c\<^sub>G\<close>
    by (metis "Act-Basic:2" "con-dis-i-e:2:a" "intro-elim:3:a")
  AOT_hence \<open>\<^bold>\<A>A!\<^bold>c\<^sub>G\<close>
    using "rule-id-df:1[zero]"[OF concepts, OF "oa-exist:2"]
          "rule=E" by fast
  AOT_hence \<open>A!\<^bold>c\<^sub>G\<close>
    using "oa-facts:8"[unvarify x, THEN "\<equiv>E"(2)] "concept-G[den]" by blast
  thus ?thesis
    using "rule-id-df:1[zero]"[OF concepts, OF "oa-exist:2", symmetric]
          "rule=E" by fast
qed

AOT_theorem "conG-strict": \<open>\<^bold>c\<^sub>G = \<^bold>\<iota>c \<forall>F(c[F] \<equiv> [G] \<Rightarrow> [F])\<close>
proof (rule "id-eq:3"[unvarify \<alpha> \<beta> \<gamma>, THEN "\<rightarrow>E"])
  AOT_have \<open>\<box>\<forall>x (C!x & ConceptOf(x,G) \<equiv> C!x & \<forall>F (x[F] \<equiv> [G] \<Rightarrow> [F]))\<close>
    by (auto intro!: "concept-of-G"[THEN "\<equiv>\<^sub>d\<^sub>fI"] RN GEN "\<equiv>I" "\<rightarrow>I" "&I" "cqt:2"
               dest: "&E";
        auto dest: "\<forall>E"(2) "\<equiv>E"(1,2) dest!: "&E"(2) "concept-of-G"[THEN "\<equiv>\<^sub>d\<^sub>fE"])
  AOT_thus \<open>\<^bold>c\<^sub>G = \<^bold>\<iota>c ConceptOf(c, G) & \<^bold>\<iota>c ConceptOf(c, G) = \<^bold>\<iota>c \<forall>F(c[F] \<equiv> [G] \<Rightarrow> [F])\<close>
    by (auto intro!: "&I" "rule-id-df:1"[OF "concept-G"] "con-exists:3"
                      "equiv-desc-eq:3"[THEN "\<rightarrow>E"])
qed(auto simp: "concept-G[den]" "con-exists:3" "concept-comp:3")

AOT_theorem "conG-lemma:1": \<open>\<forall>F(\<^bold>c\<^sub>G[F] \<equiv> [G] \<Rightarrow> [F])\<close>
proof(safe intro!: GEN "\<equiv>I" "\<rightarrow>I")
  fix F
  AOT_have \<open>\<^bold>\<A>\<forall>F(\<^bold>c\<^sub>G[F] \<equiv> [G] \<Rightarrow> [F])\<close>
    using "actual-desc:4"[THEN "\<rightarrow>E", OF "concept-comp:3",
                          THEN "Act-Basic:2"[THEN "\<equiv>E"(1)],
                          THEN "&E"(2)]
          "conG-strict"[symmetric] "rule=E" by fast
  AOT_hence \<open>\<^bold>\<A>(\<^bold>c\<^sub>G[F] \<equiv> [G] \<Rightarrow> [F])\<close>
    using "logic-actual-nec:3"[axiom_inst, THEN "\<equiv>E"(1)] "\<forall>E"(2)
    by blast
  AOT_hence 0: \<open>\<^bold>\<A>\<^bold>c\<^sub>G[F] \<equiv> \<^bold>\<A>[G] \<Rightarrow> [F]\<close>
    using "Act-Basic:5"[THEN "\<equiv>E"(1)] by blast
  {
    AOT_assume \<open>\<^bold>c\<^sub>G[F]\<close>
    AOT_hence \<open>\<^bold>\<A>\<^bold>c\<^sub>G[F]\<close>
      by(safe intro!: "en-eq:10[1]"[unvarify x\<^sub>1, THEN "\<equiv>E"(2)]
                      "concept-G[den]")
    AOT_hence \<open>\<^bold>\<A>[G] \<Rightarrow> [F]\<close>
      using 0[THEN "\<equiv>E"(1)] by blast
    AOT_hence \<open>\<^bold>\<A>(F\<down> & G\<down> & \<box>\<forall>x([G]x \<rightarrow> [F]x))\<close>
      by (AOT_subst_def (reverse) "F-imp-G")
    AOT_hence \<open>\<^bold>\<A>\<box>\<forall>x([G]x \<rightarrow> [F]x)\<close>
      using "Act-Basic:2"[THEN "\<equiv>E"(1)] "&E" by blast
    AOT_hence \<open>\<box>\<forall>x([G]x \<rightarrow> [F]x)\<close>
      using "qml-act:2"[axiom_inst, THEN "\<equiv>E"(2)] by simp
    AOT_thus \<open>[G] \<Rightarrow> [F]\<close>
      by (AOT_subst_def "F-imp-G"; auto intro!: "&I" "cqt:2")
  }
  {
    AOT_assume \<open>[G] \<Rightarrow> [F]\<close>
    AOT_hence \<open>\<box>\<forall>x([G]x \<rightarrow> [F]x)\<close>
      by (safe dest!: "F-imp-G"[THEN "\<equiv>\<^sub>d\<^sub>fE"] "&E"(2))
    AOT_hence \<open>\<^bold>\<A>\<box>\<forall>x([G]x \<rightarrow> [F]x)\<close>
      using "qml-act:2"[axiom_inst, THEN "\<equiv>E"(1)] by simp
    AOT_hence \<open>\<^bold>\<A>(F\<down> & G\<down> & \<box>\<forall>x([G]x \<rightarrow> [F]x))\<close>
      by (auto intro!: "Act-Basic:2"[THEN "\<equiv>E"(2)] "&I" "cqt:2"
               intro: "RA[2]")
    AOT_hence \<open>\<^bold>\<A>([G] \<Rightarrow> [F])\<close>
      by (AOT_subst_def "F-imp-G")
    AOT_hence \<open>\<^bold>\<A>\<^bold>c\<^sub>G[F]\<close>
      using 0[THEN "\<equiv>E"(2)] by blast
    AOT_thus \<open>\<^bold>c\<^sub>G[F]\<close>
      by(safe intro!: "en-eq:10[1]"[unvarify x\<^sub>1, THEN "\<equiv>E"(1)]
                      "concept-G[den]")
  }
qed

AOT_theorem conH_enc_ord:
  \<open>([H] \<Rightarrow> O!) \<rightarrow> \<box>\<forall>F \<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<^bold>c\<^sub>H[F] \<equiv> \<^bold>c\<^sub>H[G]))\<close>
proof(rule "\<rightarrow>I")
  AOT_assume 0: \<open>[H] \<Rightarrow> O!\<close>
  AOT_have 0: \<open>\<box>([H] \<Rightarrow> O!)\<close>
    apply (AOT_subst_def "F-imp-G")
    using 0[THEN "\<equiv>\<^sub>d\<^sub>fE"[OF "F-imp-G"]]
    by (auto intro!: "KBasic:3"[THEN "\<equiv>E"(2)] "&I" "exist-nec"[THEN "\<rightarrow>E"]
               dest: "&E" 4[THEN "\<rightarrow>E"])
  moreover AOT_have \<open>\<box>([H] \<Rightarrow> O!) \<rightarrow> \<box>\<forall>F \<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<^bold>c\<^sub>H[F] \<equiv> \<^bold>c\<^sub>H[G]))\<close>
  proof(rule RM; safe intro!: "\<rightarrow>I" GEN)
    AOT_modally_strict {
      fix F G
      AOT_assume \<open>[H] \<Rightarrow> O!\<close>
      AOT_hence 0: \<open>\<box>\<forall>x ([H]x \<rightarrow> O!x)\<close>
        by (safe dest!: "F-imp-G"[THEN "\<equiv>\<^sub>d\<^sub>fE"] "&E"(2))
      AOT_assume 1: \<open>\<box>G \<equiv>\<^sub>E F\<close>
      AOT_assume \<open>\<^bold>c\<^sub>H[F]\<close>
      AOT_hence \<open>[H] \<Rightarrow> [F]\<close>
        using "conG-lemma:1"[THEN "\<forall>E"(2), THEN "\<equiv>E"(1)] by simp
      AOT_hence 2: \<open>\<box>\<forall>x ([H]x \<rightarrow> [F]x)\<close>
        by (safe dest!: "F-imp-G"[THEN "\<equiv>\<^sub>d\<^sub>fE"] "&E"(2))
      AOT_modally_strict {
        AOT_assume 0: \<open>\<forall>x ([H]x \<rightarrow> O!x)\<close>
        AOT_assume 1: \<open>\<forall>x ([H]x \<rightarrow> [F]x)\<close>
        AOT_assume 2: \<open>G \<equiv>\<^sub>E F\<close>
        AOT_have \<open>\<forall>x ([H]x \<rightarrow> [G]x)\<close>
        proof(safe intro!: GEN "\<rightarrow>I")
          fix x
          AOT_assume \<open>[H]x\<close>
          AOT_hence \<open>O!x\<close> and \<open>[F]x\<close>
            using 0 1 "\<forall>E"(2) "\<rightarrow>E" by blast+
          AOT_thus \<open>[G]x\<close>
            using 2[THEN eqE[THEN "\<equiv>\<^sub>d\<^sub>fE"], THEN "&E"(2)]
                  "\<forall>E"(2) "\<rightarrow>E" "\<equiv>E"(2) calculation by blast
        qed
      }
      AOT_hence \<open>\<box>\<forall>x ([H]x \<rightarrow> [G]x)\<close>
        using "RN[prem]"[where \<Gamma>=\<open>{\<guillemotleft>\<forall>x ([H]x \<rightarrow> O!x)\<guillemotright>,
                               \<guillemotleft>\<forall>x ([H]x \<rightarrow> [F]x)\<guillemotright>,
                               \<guillemotleft>G \<equiv>\<^sub>E F\<guillemotright>}\<close>, simplified] 0 1 2 by fast
      AOT_hence \<open>[H] \<Rightarrow> [G]\<close>
        by (safe intro!: "F-imp-G"[THEN "\<equiv>\<^sub>d\<^sub>fI"] "&I" "cqt:2")
      AOT_hence \<open>\<^bold>c\<^sub>H[G]\<close>
        using "conG-lemma:1"[THEN "\<forall>E"(2), THEN "\<equiv>E"(2)] by simp
    } note 0 = this
    AOT_modally_strict {
      fix F G
      AOT_assume \<open>[H] \<Rightarrow> O!\<close>
      moreover AOT_assume \<open>\<box>G \<equiv>\<^sub>E F\<close>
      moreover AOT_have \<open>\<box>F \<equiv>\<^sub>E G\<close>
        by (AOT_subst \<open>F \<equiv>\<^sub>E G\<close> \<open>G \<equiv>\<^sub>E F\<close>)
            (auto intro!: calculation(2)
                          eqE[THEN "\<equiv>\<^sub>d\<^sub>fI"]
                          "\<equiv>I" "\<rightarrow>I" "&I" "cqt:2" Ordinary.GEN
                  dest!: eqE[THEN "\<equiv>\<^sub>d\<^sub>fE"] "&E"(2)
                  dest: "\<equiv>E"(1,2) "Ordinary.\<forall>E")
      ultimately AOT_show \<open>(\<^bold>c\<^sub>H[F] \<equiv> \<^bold>c\<^sub>H[G])\<close>
        using 0 "\<equiv>I" "\<rightarrow>I" by auto
    }
  qed
  ultimately AOT_show \<open>\<box>\<forall>F \<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<^bold>c\<^sub>H[F] \<equiv> \<^bold>c\<^sub>H[G]))\<close>
    using "\<rightarrow>E" by blast
qed

AOT_theorem concept_inclusion_denotes_1:
  \<open>([H] \<Rightarrow> O!) \<rightarrow> [\<lambda>x \<^bold>c\<^sub>H \<preceq> x]\<down>\<close>
proof(rule "\<rightarrow>I")
  AOT_assume 0: \<open>[H] \<Rightarrow> O!\<close>
  AOT_show \<open>[\<lambda>x \<^bold>c\<^sub>H \<preceq> x]\<down>\<close>
  proof(rule "safe-ext"[axiom_inst, THEN "\<rightarrow>E", OF "&I"])
    AOT_show \<open>[\<lambda>x C!x & \<forall>F(\<^bold>c\<^sub>H[F] \<rightarrow> x[F])]\<down>\<close>
      by (safe intro!: conjunction_denotes[THEN "\<rightarrow>E", OF "&I"]
                       Comprehension_2'[THEN "\<rightarrow>E"]
                       conH_enc_ord[THEN "\<rightarrow>E", OF 0]) "cqt:2"
  next
    AOT_show \<open>\<box>\<forall>x (C!x & \<forall>F (\<^bold>c\<^sub>H[F] \<rightarrow> x[F]) \<equiv> \<^bold>c\<^sub>H \<preceq> x)\<close>
      by (safe intro!: RN GEN; AOT_subst_def "con:1")
         (auto intro!: "\<equiv>I" "\<rightarrow>I" "&I" "concept-G[concept]" dest: "&E")
  qed
qed

AOT_theorem concept_inclusion_denotes_2:
  \<open>([H] \<Rightarrow> O!) \<rightarrow> [\<lambda>x x \<preceq> \<^bold>c\<^sub>H]\<down>\<close>
proof(rule "\<rightarrow>I")
  AOT_assume 0: \<open>[H] \<Rightarrow> O!\<close>
  AOT_show \<open>[\<lambda>x x \<preceq> \<^bold>c\<^sub>H]\<down>\<close>
  proof(rule "safe-ext"[axiom_inst, THEN "\<rightarrow>E", OF "&I"])
    AOT_show \<open>[\<lambda>x C!x & \<forall>F(x[F] \<rightarrow> \<^bold>c\<^sub>H[F])]\<down>\<close>
      by (safe intro!: conjunction_denotes[THEN "\<rightarrow>E", OF "&I"]
                       Comprehension_1'[THEN "\<rightarrow>E"]
                       conH_enc_ord[THEN "\<rightarrow>E", OF 0]) "cqt:2"
  next
    AOT_show \<open>\<box>\<forall>x (C!x & \<forall>F (x[F] \<rightarrow> \<^bold>c\<^sub>H[F]) \<equiv> x \<preceq> \<^bold>c\<^sub>H)\<close>
      by (safe intro!: RN GEN; AOT_subst_def "con:1")
         (auto intro!: "\<equiv>I" "\<rightarrow>I" "&I" "concept-G[concept]" dest: "&E")
  qed
qed

AOT_define ThickForm :: \<open>\<tau> \<Rightarrow> \<tau> \<Rightarrow> \<phi>\<close> (\<open>FormOf'(_,_')\<close>)
  "tform-of": \<open>FormOf(x,G) \<equiv>\<^sub>d\<^sub>f A!x & G\<down> & \<forall>F(x[F] \<equiv> [G] \<Rightarrow> [F])\<close>

AOT_theorem FormOfOrdinaryProperty: \<open>([H] \<Rightarrow> O!) \<rightarrow> [\<lambda>x FormOf(x,H)]\<down>\<close>
proof(rule "\<rightarrow>I")
  AOT_assume 0: \<open>[H] \<Rightarrow> [O!]\<close>
  AOT_show \<open>[\<lambda>x FormOf(x,H)]\<down>\<close>
  proof (rule "safe-ext"[axiom_inst, THEN "\<rightarrow>E", OF "&I"])
    AOT_show \<open>[\<lambda>x ConceptOf(x,H)]\<down>\<close>
      using 0 ConceptOfOrdinaryProperty[THEN "\<rightarrow>E"] by blast
    AOT_show \<open>\<box>\<forall>x (ConceptOf(x,H) \<equiv> FormOf(x,H))\<close>
    proof(safe intro!: RN GEN)
      AOT_modally_strict {
        fix x
        AOT_modally_strict {
          AOT_have \<open>A!x \<equiv> A!x\<close>
            by (simp add: "oth-class-taut:3:a")
          AOT_hence \<open>C!x \<equiv> A!x\<close>
            using "rule-id-df:1[zero]"[OF concepts, OF "oa-exist:2"]
                  "rule=E" id_sym by fast
        }
        AOT_thus \<open>ConceptOf(x,H) \<equiv> FormOf(x,H)\<close>
          by (AOT_subst_def "tform-of";
              AOT_subst_def "concept-of-G";
              AOT_subst \<open>C!x\<close> \<open>A!x\<close>)
             (auto intro!: "\<equiv>I" "\<rightarrow>I" "&I" dest: "&E")
      }
    qed
  qed
qed

AOT_theorem equal_E_rigid_one_to_one: \<open>Rigid\<^sub>1\<^sub>-\<^sub>1((=\<^sub>E))\<close>
proof (safe intro!: "df-1-1:2"[THEN "\<equiv>\<^sub>d\<^sub>fI"] "&I" "df-1-1:1"[THEN "\<equiv>\<^sub>d\<^sub>fI"]
                    GEN "\<rightarrow>I" "df-rigid-rel:1"[THEN "\<equiv>\<^sub>d\<^sub>fI"] "=E[denotes]")
  fix x y z
  AOT_assume \<open>x =\<^sub>E z & y =\<^sub>E z\<close>
  AOT_thus \<open>x = y\<close>
    by (metis "rule=E" "&E"(1) "Conjunction Simplification"(2)
              "=E-simple:2" id_sym "\<rightarrow>E")
next
  AOT_have \<open>\<forall>x\<forall>y \<box>(x =\<^sub>E y \<rightarrow> \<box>x =\<^sub>E y)\<close>
  proof(rule GEN; rule GEN)
    AOT_show \<open>\<box>(x =\<^sub>E y \<rightarrow> \<box>x =\<^sub>E y)\<close> for x y
      by (meson RN "deduction-theorem" "id-nec3:1" "\<equiv>E"(1))
  qed
  AOT_hence \<open>\<forall>x\<^sub>1...\<forall>x\<^sub>n \<box>([(=\<^sub>E)]x\<^sub>1...x\<^sub>n \<rightarrow> \<box>[(=\<^sub>E)]x\<^sub>1...x\<^sub>n)\<close>
    by (rule tuple_forall[THEN "\<equiv>\<^sub>d\<^sub>fI"])
  AOT_thus \<open>\<box>\<forall>x\<^sub>1...\<forall>x\<^sub>n ([(=\<^sub>E)]x\<^sub>1...x\<^sub>n \<rightarrow> \<box>[(=\<^sub>E)]x\<^sub>1...x\<^sub>n)\<close>
    using BF[THEN "\<rightarrow>E"] by fast
qed

AOT_theorem equal_E_domain: \<open>InDomainOf(x,(=\<^sub>E)) \<equiv> O!x\<close>
proof(safe intro!: "\<equiv>I" "\<rightarrow>I")
  AOT_assume \<open>InDomainOf(x,(=\<^sub>E))\<close>
  AOT_hence \<open>\<exists>y x =\<^sub>E y\<close>
    by (metis "\<equiv>\<^sub>d\<^sub>fE" "df-1-1:5")
  then AOT_obtain y where \<open>x =\<^sub>E y\<close>
    using "\<exists>E"[rotated] by blast
  AOT_thus \<open>O!x\<close>
    using "=E-simple:1"[THEN "\<equiv>E"(1)] "&E" by blast
next
  AOT_assume \<open>O!x\<close>
  AOT_hence \<open>x =\<^sub>E x\<close>
    by (metis "ord=Eequiv:1"[THEN "\<rightarrow>E"])
  AOT_hence \<open>\<exists>y x =\<^sub>E y\<close>
    using "\<exists>I"(2) by fast
  AOT_thus \<open>InDomainOf(x,(=\<^sub>E))\<close>
    by (metis "\<equiv>\<^sub>d\<^sub>fI" "df-1-1:5")
qed

AOT_theorem shared_urelement_projection_identity:
  assumes \<open>\<forall>y [\<lambda>x (y[\<lambda>z [R]zx])]\<down>\<close>
  shows \<open>\<forall>F([F]a \<equiv> [F]b) \<rightarrow> [\<lambda>z [R]za] = [\<lambda>z [R]zb]\<close>
proof(rule "\<rightarrow>I")
  AOT_assume 0: \<open>\<forall>F([F]a \<equiv> [F]b)\<close>
  {
    fix z
    AOT_have \<open>[\<lambda>x (z[\<lambda>z [R]zx])]\<down>\<close>
      using assms[THEN "\<forall>E"(2)].
    AOT_hence 1: \<open>\<forall>x \<forall>y (\<forall>F ([F]x \<equiv> [F]y) \<rightarrow> \<box>(z[\<lambda>z [R]zx] \<equiv> z[\<lambda>z [R]zy]))\<close>
      using "kirchner-thm-cor:1"[THEN "\<rightarrow>E"]
      by blast
    AOT_have \<open>\<box>(z[\<lambda>z [R]za] \<equiv> z[\<lambda>z [R]zb])\<close>
      using 1[THEN "\<forall>E"(2), THEN "\<forall>E"(2), THEN "\<rightarrow>E", OF 0] by blast
  }
  AOT_hence \<open>\<forall>z \<box>(z[\<lambda>z [R]za] \<equiv> z[\<lambda>z [R]zb])\<close>
    by (rule GEN)
  AOT_hence \<open>\<box>\<forall>z(z[\<lambda>z [R]za] \<equiv> z[\<lambda>z [R]zb])\<close>
    by (rule BF[THEN "\<rightarrow>E"])
  AOT_thus \<open>[\<lambda>z [R]za] = [\<lambda>z [R]zb]\<close>
    by (AOT_subst_def "identity:2")
       (auto intro!: "&I" "cqt:2")
qed

AOT_theorem shared_urelement_exemplification_identity:
  assumes \<open>\<forall>y [\<lambda>x (y[\<lambda>z [G]x])]\<down>\<close>
  shows \<open>\<forall>F([F]a \<equiv> [F]b) \<rightarrow> ([G]a) = ([G]b)\<close>
proof(rule "\<rightarrow>I")
  AOT_assume 0: \<open>\<forall>F([F]a \<equiv> [F]b)\<close>
  {
    fix z
    AOT_have \<open>[\<lambda>x (z[\<lambda>z [G]x])]\<down>\<close>
      using assms[THEN "\<forall>E"(2)].
    AOT_hence 1: \<open>\<forall>x \<forall>y (\<forall>F ([F]x \<equiv> [F]y) \<rightarrow> \<box>(z[\<lambda>z [G]x] \<equiv> z[\<lambda>z [G]y]))\<close>
      using "kirchner-thm-cor:1"[THEN "\<rightarrow>E"]
      by blast
    AOT_have \<open>\<box>(z[\<lambda>z [G]a] \<equiv> z[\<lambda>z [G]b])\<close>
      using 1[THEN "\<forall>E"(2), THEN "\<forall>E"(2), THEN "\<rightarrow>E", OF 0] by blast
  }
  AOT_hence \<open>\<forall>z \<box>(z[\<lambda>z [G]a] \<equiv> z[\<lambda>z [G]b])\<close>
    by (rule GEN)
  AOT_hence \<open>\<box>\<forall>z(z[\<lambda>z [G]a] \<equiv> z[\<lambda>z [G]b])\<close>
    by (rule BF[THEN "\<rightarrow>E"])
  AOT_hence \<open>[\<lambda>z [G]a] = [\<lambda>z [G]b]\<close>
    by (AOT_subst_def "identity:2")
       (auto intro!: "&I" "cqt:2")
  AOT_thus \<open>([G]a) = ([G]b)\<close>
    by (safe intro!: "identity:4"[THEN "\<equiv>\<^sub>d\<^sub>fI"] "&I" "log-prop-prop:2")
qed

text\<open>The assumptions of the theorems above are derivable, if the additional
     introduction rules for the upcoming extension of @{thm "cqt:2[lambda]"}
     are explicitly allowed (while they are currently not part of the
     abstraction layer).\<close>
notepad
begin
  AOT_modally_strict {
    AOT_have \<open>\<forall>R\<forall>y [\<lambda>x (y[\<lambda>z [R]zx])]\<down>\<close>
      by (safe intro!: GEN "cqt:2" AOT_instance_of_cqt_2_intro_next)
    AOT_have \<open>\<forall>G\<forall>y [\<lambda>x (y[\<lambda>z [G]x])]\<down>\<close>
      by (safe intro!: GEN "cqt:2" AOT_instance_of_cqt_2_intro_next)
  }
end

end


           (*-------------------------------------------*
            |                   Test                    |
            |        CSP-Prover on Isabelle2005         |
            |                  April 2006               |
            |                                           |
            |        CSP-Prover on Isabelle2009         |
            |                   June 2009  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory Test_Buffer
imports CSP_F
begin

(*****************************************************************

         1. test Buffer
         2. verification of deadlock-free.
         3.
         4.

 *****************************************************************)

datatype Event = left real | right "real * nat"
datatype Name = Empty nat | Full real nat
datatype DFName = DF

primrec
  Bufferfun :: "Name => (Name, Event) proc"
where
  "Bufferfun  (Empty n)  = left ? r -> $(Full r n)"
 |"Bufferfun  (Full r n) = right (r,n) -> $(Empty (Suc n))"

 (*
defs (overloaded)
Set_Bufferfun_def [simp]: "PNfun == Bufferfun"
*)

overloading Set_Bufferfun ==
  "PNfun :: (Name, Event) pnfun"
begin
  definition "PNfun == Bufferfun"
end

declare Set_Bufferfun_def [simp]

definition
  Buffer :: "(Name, Event) proc"
  where
  Buffer_def: "Buffer == $(Empty 0)"

(*** Spc ***)

primrec
  DFfun :: "DFName => (DFName, Event) proc"
where
  "DFfun  DF = (! x -> $DF)"
(*
defs (overloaded)
Set_DFfun_def [simp]: "PNfun == DFfun"
*)

overloading Set_DFfun ==
  "PNfun :: (DFName, Event) pnfun"
begin
  definition "PNfun == DFfun"
end

declare Set_DFfun_def [simp]

(*** To automatically unfold syntactic sugar ***)
declare csp_prefix_ss_def[simp]
declare inj_on_def[simp]

(*********************************************************
               guardedfun (rutine work)
 *********************************************************)

lemma guardedfun_Bufferfun[simp]:
     "guardedfun Bufferfun"
apply (simp add: guardedfun_def, rule)
apply (induct_tac p)
apply (simp_all)+
done

lemma guardedfun_DFfun[simp]:
     "guardedfun DFfun"
by (simp add: guardedfun_def, rule allI, induct_tac p, simp_all)

(*********************************************************
            relation between Buffer and DF
 *********************************************************)

primrec
  Buffer_to_DF :: "Name => (DFName, Event) proc"
where
  "Buffer_to_DF (Empty n)  = $DF"
 |"Buffer_to_DF (Full r n) = $DF"

(*********************************************************
               Buffer is deadlock free.
 *********************************************************)

(*** manual proof ***)

(*
defs FPmode_def [simp]: "FPmode == CMSmode"
*)
(* use the CMS approach in this example *)

overloading FPmode ==
  "FPmode :: fpmode"
begin
  definition "FPmode == CMSmode"
end

declare FPmode_def [simp]

lemma manual_proof_Buffer:
  "$DF <=F Buffer"
apply (simp add: Buffer_def)
apply (rule cspF_fp_induct_right[of _ _ "Buffer_to_DF"])
apply (simp)
apply (simp)
apply (simp)

apply (induct_tac p)
apply (simp_all)

(* Empty *)
apply (rule cspF_rw_left)
apply (rule cspF_unwind)
apply (simp)
apply (simp)
apply (simp)
apply (rule cspF_decompo_subset)
apply (simp_all)

(* Full *)
apply (rule cspF_rw_left)
apply (rule cspF_unwind)
apply (simp)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_step)

apply (simp)
apply (rule cspF_decompo_subset)
apply (simp)
apply (simp)
apply (rule cspF_reflex)
done

(*** semi-automatic proof ***)

lemma semi_auto_proof_Buffer: "$DF <=F Buffer"
apply (simp add: Buffer_def)
apply (rule cspF_fp_induct_right[of _ _ "Buffer_to_DF"])
apply (simp)+

apply (induct_tac p)
apply (cspF_auto, rule cspF_decompo_subset, simp_all)+
done

end


(*  Title:      HOL/Auth/n_german_lemma_on_inv__5.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_german Protocol Case Study*}

theory n_german_lemma_on_inv__5 imports n_german_base
begin
section{*All lemmas on causal relation between inv__5 and some rule r*}
lemma n_SendInvAckVsinv__5:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__5  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendInvAck  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__5  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "((formEval (eqn (IVar (Field (Para (Ident ''Cache'') p__Inv4) ''State'')) (Const E)) s))\<or>((formEval (neg (eqn (IVar (Field (Para (Ident ''Cache'') p__Inv4) ''State'')) (Const E))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Field (Para (Ident ''Cache'') p__Inv4) ''State'')) (Const E)) s))"
    have "?P3 s"
    apply (cut_tac a1 a2 b1 c1, simp, rule_tac x="(neg (andForm (neg (eqn (IVar (Field (Para (Ident ''Cache'') p__Inv4) ''State'')) (Const I))) (neg (eqn (IVar (Field (Para (Ident ''Cache'') p__Inv4) ''Data'')) (IVar (Ident ''AuxData''))))))" in exI, auto) done
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (neg (eqn (IVar (Field (Para (Ident ''Cache'') p__Inv4) ''State'')) (Const E))) s))"
    have "?P3 s"
    apply (cut_tac a1 a2 b1 c1, simp, rule_tac x="(neg (andForm (andForm (eqn (IVar (Ident ''ExGntd'')) (Const true)) (neg (eqn (IVar (Field (Para (Ident ''Cache'') p__Inv4) ''State'')) (Const E)))) (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv4) ''Cmd'')) (Const Inv))))" in exI, auto) done
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_RecvInvAckVsinv__5:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__5  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvInvAck  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__5  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))\<or>((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))\<or>((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))"
    have "?P2 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendGntEVsinv__5:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__5  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendGntE N i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__5  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Field (Para (Ident ''Chan3'') p__Inv4) ''Cmd'')) (Const InvAck)) (eqn (IVar (Para (Ident ''ShrSet'') p__Inv4)) (Const false))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Field (Para (Ident ''Chan3'') p__Inv4) ''Cmd'')) (Const InvAck)) (eqn (IVar (Para (Ident ''ShrSet'') p__Inv4)) (Const false))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_StoreVsinv__5:
assumes a1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__5  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i d where a1:"i\<le>N\<and>d\<le>N\<and>r=n_Store  i d" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__5  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Field (Para (Ident ''Chan3'') p__Inv4) ''Cmd'')) (Const InvAck)) (eqn (IVar (Field (Para (Ident ''Cache'') p__Inv4) ''State'')) (Const E))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Field (Para (Ident ''Chan3'') p__Inv4) ''Cmd'')) (Const InvAck)) (eqn (IVar (Field (Para (Ident ''Cache'') i) ''State'')) (Const E))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendReqESVsinv__5:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendReqES  i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__5  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvGntSVsinv__5:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvGntS  i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__5  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendGntSVsinv__5:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendGntS  i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__5  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendInvSVsinv__5:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendInvS  i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__5  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendInvEVsinv__5:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendInvE  i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__5  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvGntEVsinv__5:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvGntE  i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__5  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvReqVsinv__5:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvReq N i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__5  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendReqSVsinv__5:
  assumes a1: "\<exists> j. j\<le>N\<and>r=n_SendReqS  j" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__5  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendReqEIVsinv__5:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendReqEI  i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__5  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

end


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

section\<open>The Original Otway-Rees Protocol\<close>

theory OtwayRees imports Public begin

text\<open>From page 244 of
  Burrows, Abadi and Needham (1989).  A Logic of Authentication.
  Proc. Royal Soc. 426

This is the original version, which encrypts Nonce NB.\<close>

inductive_set otway :: "event list set"
  where
   Nil:  "[] \<in> otway"
   \<comment> \<open>Initial trace is empty\<close>
 | Fake: "\<lbrakk>evsf \<in> otway;  X \<in> synth (analz (knows Spy evsf)) \<rbrakk>
          \<Longrightarrow> Says Spy B X  # evsf \<in> otway"
   \<comment> \<open>The spy can say almost anything.\<close>
 | Reception: "\<lbrakk>evsr \<in> otway;  Says A B X \<in>set evsr\<rbrakk> \<Longrightarrow> Gets B X # evsr \<in> otway"
   \<comment> \<open>A message that has been sent can be received by the intended recipient.\<close>
 | OR1:  "\<lbrakk>evs1 \<in> otway;  Nonce NA \<notin> used evs1\<rbrakk>
          \<Longrightarrow> Says A B \<lbrace>Nonce NA, Agent A, Agent B,
                         Crypt (shrK A) \<lbrace>Nonce NA, Agent A, Agent B\<rbrace> \<rbrace>
                 # evs1 \<in> otway"
  \<comment> \<open>Alice initiates a protocol run\<close>
 | OR2:  "\<lbrakk>evs2 \<in> otway;  Nonce NB \<notin> used evs2;
             Gets B \<lbrace>Nonce NA, Agent A, Agent B, X\<rbrace> \<in> set evs2\<rbrakk>
          \<Longrightarrow> Says B Server
                  \<lbrace>Nonce NA, Agent A, Agent B, X,
                    Crypt (shrK B)
                      \<lbrace>Nonce NA, Nonce NB, Agent A, Agent B\<rbrace>\<rbrace>
                 # evs2 \<in> otway"
   \<comment> \<open>Bob's response to Alice's message.  Note that NB is encrypted.\<close>
 | OR3:  "\<lbrakk>evs3 \<in> otway;  Key KAB \<notin> used evs3;
             Gets Server
                  \<lbrace>Nonce NA, Agent A, Agent B,
                    Crypt (shrK A) \<lbrace>Nonce NA, Agent A, Agent B\<rbrace>,
                    Crypt (shrK B) \<lbrace>Nonce NA, Nonce NB, Agent A, Agent B\<rbrace>\<rbrace>
               \<in> set evs3\<rbrakk>
          \<Longrightarrow> Says Server B
                  \<lbrace>Nonce NA,
                    Crypt (shrK A) \<lbrace>Nonce NA, Key KAB\<rbrace>,
                    Crypt (shrK B) \<lbrace>Nonce NB, Key KAB\<rbrace>\<rbrace>
                 # evs3 \<in> otway"
   \<comment> \<open>The Server receives Bob's message and checks that the three NAs
       match.  Then he sends a new session key to Bob with a packet for forwarding to Alice\<close>
 | OR4:  "\<lbrakk>evs4 \<in> otway;  B \<noteq> Server;
             Says B Server \<lbrace>Nonce NA, Agent A, Agent B, X',
                             Crypt (shrK B)
                                   \<lbrace>Nonce NA, Nonce NB, Agent A, Agent B\<rbrace>\<rbrace>
               \<in> set evs4;
             Gets B \<lbrace>Nonce NA, X, Crypt (shrK B) \<lbrace>Nonce NB, Key K\<rbrace>\<rbrace>
               \<in> set evs4\<rbrakk>
          \<Longrightarrow> Says B A \<lbrace>Nonce NA, X\<rbrace> # evs4 \<in> otway"
   \<comment> \<open>Bob receives the Server's (?) message and compares the Nonces with
       those in the message he previously sent the Server.
       Need @{term"B \<noteq> Server"} because we allow messages to self.\<close>
 | Oops: "\<lbrakk>evso \<in> otway;
             Says Server B \<lbrace>Nonce NA, X, Crypt (shrK B) \<lbrace>Nonce NB, Key K\<rbrace>\<rbrace>
               \<in> set evso\<rbrakk>
          \<Longrightarrow> Notes Spy \<lbrace>Nonce NA, Nonce NB, Key K\<rbrace> # evso \<in> otway"
   \<comment> \<open>This message models possible leaks of session keys.  The nonces identify the protocol run\<close>

declare Says_imp_analz_Spy [dest]
declare parts.Body  [dest]
declare analz_into_parts [dest]
declare Fake_parts_insert_in_Un  [dest]

text\<open>A "possibility property": there are traces that reach the end\<close>
lemma "\<lbrakk>B \<noteq> Server; Key K \<notin> used []\<rbrakk>
      \<Longrightarrow> \<exists>evs \<in> otway.
             Says B A \<lbrace>Nonce NA, Crypt (shrK A) \<lbrace>Nonce NA, Key K\<rbrace>\<rbrace>
               \<in> set evs"
apply (intro exI bexI)
apply (rule_tac [2] otway.Nil
                    [THEN otway.OR1, THEN otway.Reception,
                     THEN otway.OR2, THEN otway.Reception,
                     THEN otway.OR3, THEN otway.Reception, THEN otway.OR4])
apply (possibility, simp add: used_Cons)
done

lemma Gets_imp_Says [dest!]:
     "\<lbrakk>Gets B X \<in> set evs; evs \<in> otway\<rbrakk> \<Longrightarrow> \<exists>A. Says A B X \<in> set evs"
apply (erule rev_mp)
apply (erule otway.induct, auto)
done

(** For reasoning about the encrypted portion of messages **)

lemma OR2_analz_knows_Spy:
     "\<lbrakk>Gets B \<lbrace>N, Agent A, Agent B, X\<rbrace> \<in> set evs;  evs \<in> otway\<rbrakk>
      \<Longrightarrow> X \<in> analz (knows Spy evs)"
  by blast

lemma OR4_analz_knows_Spy:
     "\<lbrakk>Gets B \<lbrace>N, X, Crypt (shrK B) X'\<rbrace> \<in> set evs;  evs \<in> otway\<rbrakk>
      \<Longrightarrow> X \<in> analz (knows Spy evs)"
  by blast

(*These lemmas assist simplification by removing forwarded X-variables.
  We can replace them by rewriting with parts_insert2 and proving using
  dest: parts_cut, but the proofs become more difficult.*)
lemmas OR2_parts_knows_Spy =
    OR2_analz_knows_Spy [THEN analz_into_parts]

(*There could be OR4_parts_knows_Spy and Oops_parts_knows_Spy, but for
  some reason proofs work without them!*)

text\<open>Theorems of the form \<^term>\<open>X \<notin> parts (spies 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> otway \<Longrightarrow> (Key (shrK A) \<in> parts (knows Spy evs)) = (A \<in> bad)"
by (erule otway.induct, force,
    drule_tac [4] OR2_parts_knows_Spy, simp_all, blast+)

lemma Spy_analz_shrK [simp]:
     "evs \<in> otway \<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> otway\<rbrakk> \<Longrightarrow> A \<in> bad"
by (blast dest: Spy_see_shrK)

subsection\<open>Towards Secrecy: Proofs Involving \<^term>\<open>analz\<close>\<close>

text \<open>Describes the form of K and NA when the Server sends this message.  Also
  for Oops case.\<close>
lemma Says_Server_message_form:
     "\<lbrakk>Says Server B \<lbrace>NA, X, Crypt (shrK B) \<lbrace>NB, Key K\<rbrace>\<rbrace> \<in> set evs;
         evs \<in> otway\<rbrakk>
      \<Longrightarrow> K \<notin> range shrK \<and> (\<exists>i. NA = Nonce i) \<and> (\<exists>j. NB = Nonce j)"
by (erule rev_mp, erule otway.induct, simp_all)

(****
 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.
****)

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

text\<open>The equality makes the induction hypothesis easier to apply\<close>
lemma analz_image_freshK [rule_format]:
 "evs \<in> otway \<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))"
apply (erule otway.induct)
apply (frule_tac [8] Says_Server_message_form)
apply (drule_tac [7] OR4_analz_knows_Spy)
apply (drule_tac [5] OR2_analz_knows_Spy, analz_freshK, spy_analz, auto)
done

lemma analz_insert_freshK:
  "\<lbrakk>evs \<in> otway;  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 B \<lbrace>NA, X, Crypt (shrK B) \<lbrace>NB, K\<rbrace>\<rbrace>   \<in> set evs;
         Says Server B' \<lbrace>NA',X',Crypt (shrK B') \<lbrace>NB',K\<rbrace>\<rbrace> \<in> set evs;
         evs \<in> otway\<rbrakk> \<Longrightarrow> X=X' \<and> B=B' \<and> NA=NA' \<and> NB=NB'"
apply (erule rev_mp)
apply (erule rev_mp)
apply (erule otway.induct, simp_all)
apply blast+  \<comment> \<open>OR3 and OR4\<close>
done

subsection\<open>Authenticity properties relating to NA\<close>

text\<open>Only OR1 can have caused such a part of a message to appear.\<close>
lemma Crypt_imp_OR1 [rule_format]:
 "\<lbrakk>A \<notin> bad;  evs \<in> otway\<rbrakk>
  \<Longrightarrow> Crypt (shrK A) \<lbrace>NA, Agent A, Agent B\<rbrace> \<in> parts (knows Spy evs) \<longrightarrow>
      Says A B \<lbrace>NA, Agent A, Agent B,
                 Crypt (shrK A) \<lbrace>NA, Agent A, Agent B\<rbrace>\<rbrace>
        \<in> set evs"
by (erule otway.induct, force,
    drule_tac [4] OR2_parts_knows_Spy, simp_all, blast+)

lemma Crypt_imp_OR1_Gets:
     "\<lbrakk>Gets B \<lbrace>NA, Agent A, Agent B,
                  Crypt (shrK A) \<lbrace>NA, Agent A, Agent B\<rbrace>\<rbrace> \<in> set evs;
         A \<notin> bad; evs \<in> otway\<rbrakk>
       \<Longrightarrow> Says A B \<lbrace>NA, Agent A, Agent B,
                      Crypt (shrK A) \<lbrace>NA, Agent A, Agent B\<rbrace>\<rbrace>
             \<in> set evs"
by (blast dest: Crypt_imp_OR1)

text\<open>The Nonce NA uniquely identifies A's message\<close>
lemma unique_NA:
     "\<lbrakk>Crypt (shrK A) \<lbrace>NA, Agent A, Agent B\<rbrace> \<in> parts (knows Spy evs);
         Crypt (shrK A) \<lbrace>NA, Agent A, Agent C\<rbrace> \<in> parts (knows Spy evs);
         evs \<in> otway;  A \<notin> bad\<rbrakk>
      \<Longrightarrow> B = C"
apply (erule rev_mp, erule rev_mp)
apply (erule otway.induct, force,
       drule_tac [4] OR2_parts_knows_Spy, simp_all, blast+)
done

text\<open>It is impossible to re-use a nonce in both OR1 and OR2.  This holds because
  OR2 encrypts Nonce NB.  It prevents the attack that can occur in the
  over-simplified version of this protocol: see \<open>OtwayRees_Bad\<close>.\<close>
lemma no_nonce_OR1_OR2:
   "\<lbrakk>Crypt (shrK A) \<lbrace>NA, Agent A, Agent B\<rbrace> \<in> parts (knows Spy evs);
       A \<notin> bad;  evs \<in> otway\<rbrakk>
    \<Longrightarrow> Crypt (shrK A) \<lbrace>NA', NA, Agent A', Agent A\<rbrace> \<notin> parts (knows Spy evs)"
apply (erule rev_mp)
apply (erule otway.induct, force,
       drule_tac [4] OR2_parts_knows_Spy, simp_all, blast+)
done

text\<open>Crucial property: If the encrypted message appears, and A has used NA
  to start a run, then it originated with the Server!\<close>
lemma NA_Crypt_imp_Server_msg [rule_format]:
     "\<lbrakk>A \<notin> bad;  evs \<in> otway\<rbrakk>
      \<Longrightarrow> Says A B \<lbrace>NA, Agent A, Agent B,
                     Crypt (shrK A) \<lbrace>NA, Agent A, Agent B\<rbrace>\<rbrace> \<in> set evs \<longrightarrow>
          Crypt (shrK A) \<lbrace>NA, Key K\<rbrace> \<in> parts (knows Spy evs)
          \<longrightarrow> (\<exists>NB. Says Server B
                         \<lbrace>NA,
                           Crypt (shrK A) \<lbrace>NA, Key K\<rbrace>,
                           Crypt (shrK B) \<lbrace>NB, Key K\<rbrace>\<rbrace> \<in> set evs)"
apply (erule otway.induct, force,
       drule_tac [4] OR2_parts_knows_Spy, simp_all, blast)
  subgoal \<comment> \<open>OR1: by freshness\<close>
    by blast
  subgoal \<comment> \<open>OR3\<close>
    by (blast dest!: no_nonce_OR1_OR2 intro: unique_NA)
  subgoal \<comment> \<open>OR4\<close>
    by (blast intro!: Crypt_imp_OR1)
done

text\<open>Corollary: if A receives B's OR4 message and the nonce NA agrees
  then the key really did come from the Server!  CANNOT prove this of the
  bad form of this protocol, even though we can prove
  \<open>Spy_not_see_encrypted_key\<close>\<close>
lemma A_trusts_OR4:
     "\<lbrakk>Says A  B \<lbrace>NA, Agent A, Agent B,
                     Crypt (shrK A) \<lbrace>NA, Agent A, Agent B\<rbrace>\<rbrace> \<in> set evs;
         Says B' A \<lbrace>NA, Crypt (shrK A) \<lbrace>NA, Key K\<rbrace>\<rbrace> \<in> set evs;
     A \<notin> bad;  evs \<in> otway\<rbrakk>
  \<Longrightarrow> \<exists>NB. Says Server B
               \<lbrace>NA,
                 Crypt (shrK A) \<lbrace>NA, Key K\<rbrace>,
                 Crypt (shrK B) \<lbrace>NB, Key K\<rbrace>\<rbrace>
                 \<in> set evs"
by (blast intro!: NA_Crypt_imp_Server_msg)

text\<open>Crucial secrecy property: Spy does not see the keys sent in msg OR3
    Does not in itself guarantee security: an attack could violate
    the premises, e.g. by having \<^term>\<open>A=Spy\<close>\<close>
lemma secrecy_lemma:
 "\<lbrakk>A \<notin> bad;  B \<notin> bad;  evs \<in> otway\<rbrakk>
  \<Longrightarrow> Says Server B
        \<lbrace>NA, Crypt (shrK A) \<lbrace>NA, Key K\<rbrace>,
          Crypt (shrK B) \<lbrace>NB, Key K\<rbrace>\<rbrace> \<in> set evs \<longrightarrow>
      Notes Spy \<lbrace>NA, NB, Key K\<rbrace> \<notin> set evs \<longrightarrow>
      Key K \<notin> analz (knows Spy evs)"
  apply (erule otway.induct, force, simp_all)
  subgoal \<comment> \<open>Fake\<close>
    by spy_analz
  subgoal \<comment> \<open>OR2\<close>
    by (drule OR2_analz_knows_Spy) (auto simp: analz_insert_eq)
  subgoal \<comment> \<open>OR3\<close>
    by (auto simp add: analz_insert_freshK pushes)
  subgoal \<comment> \<open>OR4\<close>
    by (drule OR4_analz_knows_Spy) (auto simp: analz_insert_eq)
  subgoal \<comment> \<open>Oops\<close>
    by (auto simp add: Says_Server_message_form analz_insert_freshK unique_session_keys)
  done

theorem Spy_not_see_encrypted_key:
     "\<lbrakk>Says Server B
          \<lbrace>NA, Crypt (shrK A) \<lbrace>NA, Key K\<rbrace>,
                Crypt (shrK B) \<lbrace>NB, Key K\<rbrace>\<rbrace> \<in> set evs;
         Notes Spy \<lbrace>NA, NB, Key K\<rbrace> \<notin> set evs;
         A \<notin> bad;  B \<notin> bad;  evs \<in> otway\<rbrakk>
      \<Longrightarrow> Key K \<notin> analz (knows Spy evs)"
by (blast dest: Says_Server_message_form secrecy_lemma)

text\<open>This form is an immediate consequence of the previous result.  It is
similar to the assertions established by other methods.  It is equivalent
to the previous result in that the Spy already has \<^term>\<open>analz\<close> and
\<^term>\<open>synth\<close> at his disposal.  However, the conclusion
\<^term>\<open>Key K \<notin> knows Spy evs\<close> appears not to be inductive: all the cases
other than Fake are trivial, while Fake requires
\<^term>\<open>Key K \<notin> analz (knows Spy evs)\<close>.\<close>
lemma Spy_not_know_encrypted_key:
     "\<lbrakk>Says Server B
          \<lbrace>NA, Crypt (shrK A) \<lbrace>NA, Key K\<rbrace>,
                Crypt (shrK B) \<lbrace>NB, Key K\<rbrace>\<rbrace> \<in> set evs;
         Notes Spy \<lbrace>NA, NB, Key K\<rbrace> \<notin> set evs;
         A \<notin> bad;  B \<notin> bad;  evs \<in> otway\<rbrakk>
      \<Longrightarrow> Key K \<notin> knows Spy evs"
by (blast dest: Spy_not_see_encrypted_key)

text\<open>A's guarantee.  The Oops premise quantifies over NB because A cannot know
  what it is.\<close>
lemma A_gets_good_key:
     "\<lbrakk>Says A  B \<lbrace>NA, Agent A, Agent B,
                     Crypt (shrK A) \<lbrace>NA, Agent A, Agent B\<rbrace>\<rbrace> \<in> set evs;
         Says B' A \<lbrace>NA, Crypt (shrK A) \<lbrace>NA, Key K\<rbrace>\<rbrace> \<in> set evs;
         \<forall>NB. Notes Spy \<lbrace>NA, NB, Key K\<rbrace> \<notin> set evs;
         A \<notin> bad;  B \<notin> bad;  evs \<in> otway\<rbrakk>
      \<Longrightarrow> Key K \<notin> analz (knows Spy evs)"
by (blast dest!: A_trusts_OR4 Spy_not_see_encrypted_key)

subsection\<open>Authenticity properties relating to NB\<close>

text\<open>Only OR2 can have caused such a part of a message to appear.  We do not
  know anything about X: it does NOT have to have the right form.\<close>
lemma Crypt_imp_OR2:
     "\<lbrakk>Crypt (shrK B) \<lbrace>NA, NB, Agent A, Agent B\<rbrace> \<in> parts (knows Spy evs);
         B \<notin> bad;  evs \<in> otway\<rbrakk>
      \<Longrightarrow> \<exists>X. Says B Server
                 \<lbrace>NA, Agent A, Agent B, X,
                   Crypt (shrK B) \<lbrace>NA, NB, Agent A, Agent B\<rbrace>\<rbrace>
                 \<in> set evs"
apply (erule rev_mp)
apply (erule otway.induct, force,
       drule_tac [4] OR2_parts_knows_Spy, simp_all, blast+)
done

text\<open>The Nonce NB uniquely identifies B's  message\<close>
lemma unique_NB:
     "\<lbrakk>Crypt (shrK B) \<lbrace>NA, NB, Agent A, Agent B\<rbrace> \<in> parts(knows Spy evs);
         Crypt (shrK B) \<lbrace>NC, NB, Agent C, Agent B\<rbrace> \<in> parts(knows Spy evs);
           evs \<in> otway;  B \<notin> bad\<rbrakk>
         \<Longrightarrow> NC = NA \<and> C = A"
apply (erule rev_mp, erule rev_mp)
apply (erule otway.induct, force,
       drule_tac [4] OR2_parts_knows_Spy, simp_all)
apply blast+  \<comment> \<open>Fake, OR2\<close>
done

text\<open>If the encrypted message appears, and B has used Nonce NB,
  then it originated with the Server!  Quite messy proof.\<close>
lemma NB_Crypt_imp_Server_msg [rule_format]:
 "\<lbrakk>B \<notin> bad;  evs \<in> otway\<rbrakk>
  \<Longrightarrow> Crypt (shrK B) \<lbrace>NB, Key K\<rbrace> \<in> parts (knows Spy evs)
      \<longrightarrow> (\<forall>X'. Says B Server
                     \<lbrace>NA, Agent A, Agent B, X',
                       Crypt (shrK B) \<lbrace>NA, NB, Agent A, Agent B\<rbrace>\<rbrace>
           \<in> set evs
           \<longrightarrow> Says Server B
                \<lbrace>NA, Crypt (shrK A) \<lbrace>NA, Key K\<rbrace>,
                      Crypt (shrK B) \<lbrace>NB, Key K\<rbrace>\<rbrace>
                    \<in> set evs)"
apply simp
apply (erule otway.induct, force, simp_all)
  subgoal \<comment> \<open>Fake\<close>
    by blast
  subgoal \<comment> \<open>OR2\<close>
    by (force dest!: OR2_parts_knows_Spy)
  subgoal \<comment> \<open>OR3\<close>
    by (blast dest: unique_NB dest!: no_nonce_OR1_OR2)  \<comment> \<open>OR3\<close>
  subgoal \<comment> \<open>OR4\<close>
    by (blast dest!: Crypt_imp_OR2)
done

text\<open>Guarantee for B: if it gets a message with matching NB then the Server
  has sent the correct message.\<close>
theorem B_trusts_OR3:
     "\<lbrakk>Says B Server \<lbrace>NA, Agent A, Agent B, X',
                         Crypt (shrK B) \<lbrace>NA, NB, Agent A, Agent B\<rbrace>\<rbrace>
           \<in> set evs;
         Gets B \<lbrace>NA, X, Crypt (shrK B) \<lbrace>NB, Key K\<rbrace>\<rbrace> \<in> set evs;
         B \<notin> bad;  evs \<in> otway\<rbrakk>
      \<Longrightarrow> Says Server B
               \<lbrace>NA,
                 Crypt (shrK A) \<lbrace>NA, Key K\<rbrace>,
                 Crypt (shrK B) \<lbrace>NB, Key K\<rbrace>\<rbrace>
                 \<in> set evs"
by (blast intro!: NB_Crypt_imp_Server_msg)

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

lemma OR3_imp_OR2:
     "\<lbrakk>Says Server B
              \<lbrace>NA, Crypt (shrK A) \<lbrace>NA, Key K\<rbrace>,
                Crypt (shrK B) \<lbrace>NB, Key K\<rbrace>\<rbrace> \<in> set evs;
         B \<notin> bad;  evs \<in> otway\<rbrakk>
  \<Longrightarrow> \<exists>X. Says B Server \<lbrace>NA, Agent A, Agent B, X,
                            Crypt (shrK B) \<lbrace>NA, NB, Agent A, Agent B\<rbrace>\<rbrace>
              \<in> set evs"
apply (erule rev_mp)
apply (erule otway.induct, simp_all)
apply (blast dest!: Crypt_imp_OR2)+
done

text\<open>After getting and checking OR4, agent A can trust that B has been active.
  We could probably prove that X has the expected form, but that is not
  strictly necessary for authentication.\<close>
theorem A_auths_B:
     "\<lbrakk>Says B' A \<lbrace>NA, Crypt (shrK A) \<lbrace>NA, Key K\<rbrace>\<rbrace> \<in> set evs;
         Says A  B \<lbrace>NA, Agent A, Agent B,
                     Crypt (shrK A) \<lbrace>NA, Agent A, Agent B\<rbrace>\<rbrace> \<in> set evs;
         A \<notin> bad;  B \<notin> bad;  evs \<in> otway\<rbrakk>
  \<Longrightarrow> \<exists>NB X. Says B Server \<lbrace>NA, Agent A, Agent B, X,
                               Crypt (shrK B)  \<lbrace>NA, NB, Agent A, Agent B\<rbrace>\<rbrace>
                 \<in> set evs"
by (blast dest!: A_trusts_OR4 OR3_imp_OR2)

end