theory UntypedNom
imports "Nominal2-Isabelle2015/Nominal/Nominal2" "~~/src/HOL/Eisbach/Eisbach" begin

text {* Disclaimer: Some of the definitions were copied over and adapted from Nominal2-Isabelle2015/Nominal/Nominal2/Ex/Lambda.thy *}

atom_decl name

nominal_datatype lam =
  Var "name"
| App "lam" "lam"
| Lam x::"name" l::"lam"  binds x in l ("Lam [_]. _" [100, 100] 100)

definition
  Name :: "nat \<Rightarrow> name"
where
  "Name n = Abs_name (Atom (Sort ''name'' []) n)"

definition
   "Ident2 = Lam [Name 1].(Var (Name 1))"

definition
   "Ident x = Lam [x].(Var x)"

lemma "Ident2 = Ident x"
unfolding Ident_def Ident2_def
by simp

lemma "Ident x = Ident y"
unfolding Ident_def
by simp

nominal_function
  subst :: "lam \<Rightarrow> name \<Rightarrow> lam \<Rightarrow> lam"  ("_ [_ ::= _]" [90, 90, 90] 90)
where
  "(Var x)[y ::= s] = (if x = y then s else (Var x))"
| "(App t1 t2)[y ::= s] = App (t1[y ::= s]) (t2[y ::= s])"
| "atom x \<sharp> (y, s) \<Longrightarrow> (Lam [x]. t)[y ::= s] = Lam [x].(t[y ::= s])"
  apply(simp add: eqvt_def subst_graph_aux_def)
  apply(rule TrueI)
  using [[simproc del: alpha_lst]]
  apply(auto)
  apply(rule_tac y="a" and c="(aa, b)" in lam.strong_exhaust)
  apply(blast)+
  using [[simproc del: alpha_lst]]
  apply(simp_all add: fresh_star_def fresh_Pair_elim)
  apply (erule_tac c="(ya,sa)" in Abs_lst1_fcb2)
  apply(simp_all add: Abs_fresh_iff)
  apply(simp add: fresh_star_def fresh_Pair)
  apply(simp only: eqvt_at_def)
  apply(perm_simp)
  apply(simp)
  apply(simp add: fresh_star_Pair perm_supp_eq)
  apply(simp only: eqvt_at_def)
  apply(perm_simp)
  apply(simp)
  apply(simp add: fresh_star_Pair perm_supp_eq)
done

nominal_termination (eqvt)
  by lexicographic_order

lemma forget:
  shows "atom x \<sharp> t \<Longrightarrow> t[x ::= s] = t"
  by (nominal_induct t avoiding: x s rule: lam.strong_induct)
     (auto simp add: fresh_at_base)

lemma fresh_fact:
  fixes z::"name"
  assumes a: "atom z \<sharp> s"
      and b: "z = y \<or> atom z \<sharp> t"
  shows "atom z \<sharp> t[y ::= s]"
  using a b
  by (nominal_induct t avoiding: z y s rule: lam.strong_induct)
      (auto simp add: fresh_at_base)

lemma substitution_lemma:
  assumes a: "x \<noteq> y" "atom x \<sharp> u"
  shows "t[x ::= s][y ::= u] = t[y ::= u][x ::= s[y ::= u]]"
using a
by (nominal_induct t avoiding: x y s u rule: lam.strong_induct)
   (auto simp add: fresh_fact forget)

subsection {* single-step beta-reduction *}

inductive
  beta :: "lam \<Rightarrow> lam \<Rightarrow> bool" (" _ \<longrightarrow>b _" [80,80] 80)
where
  red_L[intro]: "t1 \<longrightarrow>b t2 \<Longrightarrow> App t1 s \<longrightarrow>b App t2 s"
| red_R[intro]: "s1 \<longrightarrow>b s2 \<Longrightarrow> App t s1 \<longrightarrow>b App t s2"
| abst[intro]: "t1 \<longrightarrow>b t2 \<Longrightarrow> Lam [x]. t1 \<longrightarrow>b Lam [x]. t2"
| beta[intro]: "atom x \<sharp> s \<Longrightarrow> App (Lam [x]. t) s \<longrightarrow>b t[x ::= s]"

equivariance beta

nominal_inductive beta
  avoids beta: "x"
  by (simp_all add: fresh_star_def fresh_Pair  fresh_fact)

subsection {* lambda beta theory *}

inductive lam_beta_eq :: "lam \<Rightarrow> lam \<Rightarrow> bool" ("\<lambda>b \<turnstile> _ = _") where
refl: "\<lambda>b \<turnstile> s = s" |
sym: "\<lambda>b \<turnstile> s = t \<Longrightarrow> \<lambda>b \<turnstile> t = s" |
trans: "\<lambda>b \<turnstile> s = t \<Longrightarrow> \<lambda>b \<turnstile> t = u \<Longrightarrow> \<lambda>b \<turnstile> s = u" |
app: "\<lambda>b \<turnstile> s = s' \<Longrightarrow> \<lambda>b \<turnstile> t = t' \<Longrightarrow> \<lambda>b \<turnstile> (App s t) = (App s' t')" |
beta: "atom x \<sharp> t \<Longrightarrow> \<lambda>b \<turnstile> (App (Lam [x]. s) t) = s [x ::= t]"

equivariance lam_beta_eq

nominal_inductive lam_beta_eq
  avoids beta: "x"
  by (simp_all add: fresh_star_def fresh_Pair  fresh_fact)

subsection {* parallel beta reduction *}

inductive
  pbeta :: "lam \<Rightarrow> lam \<Rightarrow> bool" (" _ \<rightarrow>\<parallel>b _" [80,80] 80)
where
  refl[intro]: "(Var x) \<rightarrow>\<parallel>b (Var x)"
| p_app[intro]: "s \<rightarrow>\<parallel>b s' \<Longrightarrow> t \<rightarrow>\<parallel>b t' \<Longrightarrow> App s t \<rightarrow>\<parallel>b App s' t'"
| p_abs[intro]: "t1 \<rightarrow>\<parallel>b t2 \<Longrightarrow> Lam [x]. t1 \<rightarrow>\<parallel>b Lam [x]. t2"
| p_beta[intro]: "\<lbrakk> atom x \<sharp> t' ; atom x \<sharp> t \<rbrakk> \<Longrightarrow> s \<rightarrow>\<parallel>b s' \<Longrightarrow> t \<rightarrow>\<parallel>b t' \<Longrightarrow> App (Lam [x]. s) t \<rightarrow>\<parallel>b s'[x ::= t']"

equivariance pbeta

nominal_inductive pbeta
  avoids p_beta: "x" | p_abs: "x" (*don't understand what this does exactly or why we need it...*)
  by (simp_all add: fresh_star_def fresh_Pair  fresh_fact)

nominal_function
  not_abst :: "lam \<Rightarrow> bool"
where
  "not_abst (Var x) = True"
| "not_abst (App t1 t2) = True"
| "not_abst (Lam [x]. t) = False"
apply (simp add: eqvt_def not_abst_graph_aux_def)
apply (rule TrueI)
apply (rule_tac y="x" in lam.exhaust)
using [[simproc del: alpha_lst]]
by auto

nominal_termination (eqvt) by lexicographic_order

subsection {* parallel beta reduction *}

inductive
  pbeta_max :: "lam \<Rightarrow> lam \<Rightarrow> bool" (" _ >>> _" [80,80] 80)
where
  cd_refl[intro]: "(Var x) >>> (Var x)"
| cd_app[intro]: "not_abst s \<Longrightarrow> s >>> s' \<Longrightarrow> t >>> t' \<Longrightarrow> App s t >>> App s' t'"
| cd_abs[intro]: "t1 >>> t2 \<Longrightarrow> Lam [x]. t1 >>> Lam [x]. t2"
| cd_beta[intro]: "atom x \<sharp> t' \<Longrightarrow> atom x \<sharp> t \<Longrightarrow> s >>> s' \<Longrightarrow> t >>> t' \<Longrightarrow> App (Lam [x]. s) t >>> s'[x ::= t']"

equivariance pbeta_max

nominal_inductive pbeta_max
  avoids cd_beta: "x" | cd_abs: "x" (*don't understand what this does exactly or why we need it in the abs case ...*)
  by (simp_all add: fresh_star_def fresh_Pair fresh_fact)

thm pbeta_max.strong_induct

lemma Ex1_5: "x \<noteq> y \<Longrightarrow> atom x \<sharp> u \<Longrightarrow> (s[x ::= t])[y ::= u] = s[y ::= u][x ::= t[y ::= u]]"
proof (nominal_induct s avoiding: x y u t rule:lam.strong_induct)
case (Var s) thus ?case
  apply (cases "x = s")
  apply (cases "y = s")
  apply simp
  defer
  apply simp
  apply (subst forget) using Var
  by simp+
next
case (App p q)
  thus ?case by simp
next
case (Lam z p)
  show ?case
  apply (subst subst.simps(3), simp add: Lam fresh_fact)+
  using Lam by simp
qed

lemma Lem2_5_1:
  assumes "s \<rightarrow>\<parallel>b s'"
      and "t \<rightarrow>\<parallel>b t'"
      shows "(s[x ::= t]) \<rightarrow>\<parallel>b (s'[x ::= t'])"
using assms proof (nominal_induct s s' avoiding: x t t' rule:pbeta.strong_induct)
case (refl s)
  then show ?case by auto
  (*proof (nominal_induct s avoiding: x t t' rule:lam.strong_induct)
  case (Var n)
    thus ?case unfolding subst.simps
    apply (cases "n = x")
    apply simp+
    by (rule pbeta.refl)
  next
  case App thus ?case unfolding subst.simps apply (rule_tac pbeta.p_app) by simp+
  next
  case Lam thus ?case unfolding subst.simps by auto
  qed*)
next
case p_app
  show ?case
  unfolding subst.simps
  apply (rule pbeta.p_app)
  using p_app
  by simp+
next
case (p_beta y q' q p p')
  have "App ((Lam [y]. p) [x ::= t]) (q [x ::= t]) \<rightarrow>\<parallel>b (p' [x ::= t'])[y ::= q'[x ::= t']]"
  apply (subst subst.simps(3))
  defer
  apply (rule_tac pbeta.p_beta)
  using p_beta by (simp add: fresh_fact)+

  then show ?case unfolding subst.simps
  apply (subst Ex1_5) using p_beta by simp+
next
case (p_abs p p' y)
  show ?case
  apply (subst subst.simps)
  using p_abs apply simp
  apply (subst subst.simps)
  using p_abs apply simp
  apply (rule_tac pbeta.p_abs)
  using p_abs by simp
qed

lemma pbeta_refl[intro]: "s \<rightarrow>\<parallel>b s"
apply (induct s rule:lam.induct)
by auto

lemma pbeta_max_ex:
  fixes a
  shows "\<exists>d. a >>> d"
apply (nominal_induct a rule:lam.strong_induct)
apply auto
apply (case_tac "not_abst lam1")
apply auto[1]
proof -
case goal1
  thus ?case
  apply (nominal_induct lam1 d avoiding: da lam2 rule:pbeta_max.strong_induct)
  by auto
qed

lemma subst_rename:
  assumes a: "atom y \<sharp> t"
  shows "t[x ::= s] = ((y \<leftrightarrow> x) \<bullet> t)[y ::= s]"
using a
apply (nominal_induct t avoiding: x y s rule: lam.strong_induct)
apply (auto simp add:  fresh_at_base)
done

lemma fresh_in_pbeta: "s \<rightarrow>\<parallel>b s' \<Longrightarrow> atom (x::name) \<sharp> s \<Longrightarrow>  atom x \<sharp> s'"
apply (nominal_induct s s' rule:pbeta.strong_induct)
apply simp
apply simp
apply auto[1]
proof -
case (goal1 xx)
  then have "atom x \<sharp> t" by simp
  { assume "x = xx" with goal1 have ?case by (simp add: fresh_fact) }
  { assume "x \<noteq> xx" with goal1 have ?case by (simp add: fresh_fact) }
  thus ?case using `x = xx \<Longrightarrow> atom x \<sharp> s' [xx ::= t']` by blast
qed

(* adopting great naming conventions so early on! *)
lemma aaaaa2: "(Lam [x]. s) \<rightarrow>\<parallel>b s' \<Longrightarrow> \<exists>t. s' = Lam [x]. t \<and> s \<rightarrow>\<parallel>b t"
proof (cases "(Lam [x]. s)" s' rule:pbeta.cases, simp)
  case (goal1 _ _ x')
    then have 1: "s \<rightarrow>\<parallel>b ((x' \<leftrightarrow> x) \<bullet> t2)" using pbeta.eqvt by (metis Abs1_eq_iff(3) Nominal2_Base.swap_self add_flip_cancel flip_commute flip_def permute_flip_cancel2 permute_plus)
    from goal1 have 2: "(x' \<leftrightarrow> x) \<bullet> s' = Lam [x]. ((x' \<leftrightarrow> x) \<bullet> t2)" by simp
    from goal1 have "atom x \<sharp> (Lam [x']. t2)"  using fresh_in_pbeta by (meson lam.fresh(3) list.set_intros(1))
    with 2 have "s' = Lam [x]. ((x' \<leftrightarrow> x) \<bullet> t2)" unfolding goal1 by (metis "2" flip_fresh_fresh goal1(3) lam.fresh(3) list.set_intros(1))
    with 1 show ?case by auto
qed

thm pbeta.cases
lemma pbeta_cases_2:
  shows "atom x \<sharp> t \<Longrightarrow> App (Lam [x]. s) t \<rightarrow>\<parallel>b a2 \<Longrightarrow>
    (\<And>s' t'. a2 = App (Lam [x]. s') t' \<Longrightarrow> atom x \<sharp> t' \<Longrightarrow> s \<rightarrow>\<parallel>b s' \<Longrightarrow> t \<rightarrow>\<parallel>b t' \<Longrightarrow> P) \<Longrightarrow>
    (\<And>t' s'. a2 = s' [x ::= t'] \<Longrightarrow> atom x \<sharp> t' \<Longrightarrow> atom x \<sharp> t \<Longrightarrow> s \<rightarrow>\<parallel>b s' \<Longrightarrow> t \<rightarrow>\<parallel>b t' \<Longrightarrow> P) \<Longrightarrow> P"
apply atomize_elim
proof (cases "App (Lam [x]. s) t" a2 rule:pbeta.cases, simp)
case goal1
  then obtain s'' where 1: "s' = Lam [x]. s''" "s \<rightarrow>\<parallel>b s''" using aaaaa2 by blast
  thus ?case using goal1 fresh_in_pbeta  by auto
next
case (goal2 xx _ ss)
  have 1: "s' [xx ::= t'] = ((x \<leftrightarrow> xx) \<bullet> s') [x ::= t']"
    by (metis (no_types, lifting) Abs1_eq_iff(3) Nominal2_Base.swap_self add_flip_cancel flip_def fresh_in_pbeta goal2(3) goal2(7) permute_flip_cancel permute_plus subst_rename)
  from goal2 have 2: "s \<rightarrow>\<parallel>b ((x \<leftrightarrow> xx) \<bullet> s')"
    by (metis Abs1_eq_iff(3) Nominal2_Base.swap_self add_flip_cancel flip_def pbeta.eqvt permute_flip_cancel permute_plus)
  from goal2 have 3: "atom x \<sharp> t'" using fresh_in_pbeta by simp
  with goal2 1 2 show ?case by auto
qed

lemma pbeta_max_closes_pbeta:
  fixes a b d
  assumes "a >>> d"
  and "a \<rightarrow>\<parallel>b b"
  shows "b \<rightarrow>\<parallel>b d"
using assms proof (nominal_induct arbitrary: b rule:pbeta_max.strong_induct)
case (cd_refl a)
  show ?case using cd_refl pbeta.cases by fastforce
next
case (cd_beta u ard ar al ald)
  from cd_beta(2,7) show ?case
  apply (rule_tac pbeta_cases_2)
  apply (simp, simp)
  proof -
  case (goal2 arb alb)
    with cd_beta have "alb \<rightarrow>\<parallel>b ald" "arb \<rightarrow>\<parallel>b ard" by simp+
    thus ?case unfolding goal2 apply (rule_tac Lem2_5_1) by simp+
  next
  case (goal1 alb arb)
    with cd_beta have ih: "alb \<rightarrow>\<parallel>b ald" "arb \<rightarrow>\<parallel>b ard" by simp+
    show ?case unfolding goal1
    apply (rule_tac pbeta.p_beta) using goal1 cd_beta ih
    by simp_all
  qed
next
case (cd_app al ald ar ard)
  from cd_app(6,1) show ?case
  apply (cases "App al ar" b rule:pbeta.cases)
  defer
  apply simp
  using cd_app by auto
next
case (cd_abs al ald x) thus ?case using aaaaa2 by blast
qed

lemma Lem2_5_2:
  assumes "a \<rightarrow>\<parallel>b b"
      and "a \<rightarrow>\<parallel>b c"
    shows "\<exists>d. b \<rightarrow>\<parallel>b d \<and> c \<rightarrow>\<parallel>b d"
proof -
  obtain d where 1: "a >>> d" using pbeta_max_ex by auto
  have "b \<rightarrow>\<parallel>b d \<and> c \<rightarrow>\<parallel>b d"
  apply rule
  apply (rule_tac pbeta_max_closes_pbeta)
  using 1 assms apply simp+
  apply (rule_tac pbeta_max_closes_pbeta)
  using 1 assms apply simp+
  done
  thus ?thesis by auto
qed

inductive beta_c :: "lam \<Rightarrow> lam \<Rightarrow> bool" ("_ \<longrightarrow>b* _" [80,80] 80)
where
  base[intro]: "a \<longrightarrow>b b \<Longrightarrow> a \<longrightarrow>b* b"
| refl[intro]: "a \<longrightarrow>b* a"
| trans[intro]: "\<lbrakk> a \<longrightarrow>b* b ; b \<longrightarrow>b* c \<rbrakk> \<Longrightarrow> a \<longrightarrow>b* c"

inductive pbeta_c :: "lam \<Rightarrow> lam \<Rightarrow> bool" ("_ \<rightarrow>\<parallel>b* _" [80,80] 80)
where
  base[intro]: "a \<rightarrow>\<parallel>b b \<Longrightarrow> a \<rightarrow>\<parallel>b* b"
| refl[intro]: "a \<rightarrow>\<parallel>b* a"
| trans[intro]: "\<lbrakk> a \<rightarrow>\<parallel>b* b ; b \<rightarrow>\<parallel>b* c \<rbrakk> \<Longrightarrow> a \<rightarrow>\<parallel>b* c"

definition DP :: "(lam \<Rightarrow> lam \<Rightarrow> bool) \<Rightarrow> (lam \<Rightarrow> lam \<Rightarrow> bool) \<Rightarrow> bool" where
"DP R T = (\<forall>a b c. R a b \<and> T a c \<longrightarrow> (\<exists>d. T b d \<and> R c d))"

lemma DP_R_R_imp_DP_R_Rc_pbeta:
  assumes "DP pbeta pbeta"
    shows "DP pbeta pbeta_c"
using assms unfolding DP_def
apply auto
proof -
case goal1
  from goal1(3,2) show ?case
  apply (induct arbitrary: b rule:pbeta_c.induct)
  using goal1(1) by blast+
qed

lemma DP_R_R_imp_DP_Rc_Rc_pbeta:
  assumes "DP pbeta pbeta"
    shows "DP pbeta_c pbeta_c"
using assms unfolding DP_def
apply auto
proof -
case goal1
  from goal1(2,3) show ?case
  apply (induct arbitrary: c rule:pbeta_c.induct)
  using DP_R_R_imp_DP_R_Rc_pbeta using DP_def assms apply fastforce
  apply auto
  by blast
qed

lemma M1: "m \<longrightarrow>b* m' \<Longrightarrow> m \<rightarrow>\<parallel>b* m'" sorry
lemma M2: "m \<rightarrow>\<parallel>b* m' \<Longrightarrow> m \<longrightarrow>b* m'"
proof (nominal_induct m avoiding: m' rule:lam.strong_induct)
print_cases
case (Var x) thus ?case
  apply (cases rule:pbeta_c.cases)
  apply (cases "Var x" m' rule:pbeta.cases)
  apply simp
  apply auto
  proof -
  case goal1 from goal1(1,2) show ?case sorry
  qed
next
case (App p q) from App(3) show ?case
  apply (cases rule:pbeta_c.cases)
defer
apply auto[1]
defer
  apply (cases "App p q" m' rule:pbeta.cases)
  apply auto[1]
  apply auto[1]
  sorry
next
case (Lam x p p') thus ?case sorry
qed

lemma church_rosser:
  assumes "a \<longrightarrow>b* b"
      and "a \<longrightarrow>b* c"
    shows "\<exists>d. b \<longrightarrow>b* d \<and> c \<longrightarrow>b* d"
proof -
  from assms have "a \<rightarrow>\<parallel>b* b" "a \<rightarrow>\<parallel>b* c" using M1 by simp+
  then obtain d where "b \<rightarrow>\<parallel>b* d" "c \<rightarrow>\<parallel>b* d" by (metis DP_R_R_imp_DP_Rc_Rc_pbeta DP_def Lem2_5_2)
  thus ?thesis using M2 by blast
qed

end


theory Sieve_of_Eratosthenes
  imports Main "HOL-Imperative_HOL.Array"
begin
(* Prvi deo Seminarskog *)
(* Zadatak:
  Neka je n prirodan broj. Ako su a i b prirodni brojevi vecii od 1 takvi
  da je a*b= 2*n-1, dokazati da je broj ab-(a-b)-1 oblika k*2^(2m), gde
  je k neparan prirodan, a m prirodan broj.
*)

lemma balkanska_matematicka_olimpijada_2001_prvi_zadatak_a_ge_b:
  fixes n :: nat
  fixes a b :: int
  assumes "a > 1 \<and> b > 1 \<and> a*b = 2^n-1"
  shows "\<exists> k m ::nat . (odd k) \<and> (a*b-(a-b)-1 = k*2^m)"
  using assms
  sorry

(* Drugi Deo Seminarskog *)
definition prime :: "nat ⇒ bool"  where
  "prime p ≡ 1 < p ∧ (∀m. m dvd p ⟶  m = 1 ∨ m = p)"

(*
  Pomocna lema za dokaz sledece leme
*)
lemma greater_hence_not_dvd:
  fixes a b :: nat
  assumes "a > 0 ∧ b > 0"
  assumes "a > b"
  shows "¬ a dvd b"
  using assms
  using nat_dvd_not_less
  by auto

(*
  Nije moguce racunski odrediti da li je broj prost na osnovu prethodne definicije.
  Sledeca lema omogucava izracunavanje
*)
theorem prime_code[code, simp]:
  "prime p ⟷ 1 < p ∧ (∀m∈{1..p}. m dvd p ⟶  m = 1 ∨ m = p)"
proof
  assume "prime p"
  show "1 < p ∧ (∀m∈{1..p}. m dvd p ⟶  m = 1 ∨ m = p)"
    apply (rule conjI)
  proof-
    show "1 < p"
      using ‹prime p› prime_def by simp
    show "∀m∈{1..p}. m dvd p ⟶  m = 1 ∨ m = p"
      using ‹prime p› prime_def by simp
  qed
next
  assume *: "1 < p ∧ (∀m∈{1..p}. m dvd p ⟶  m = 1 ∨ m = p)"
  show "prime p"
    unfolding prime_def
    apply (rule conjI)
  proof-
    show "1 < p"
      using * by simp
    show "∀m. m dvd p ⟶ m = 1 ∨ m = p"
    proof
      fix m
      show "m dvd p ⟶ m = 1 ∨ m = p"
      proof (cases "m > p")
        case True
        then show ?thesis
        proof-
          from ‹m > p› have **: "m > 0"
            by auto
          have "p > 0"
            using ‹1 < p› by simp
          from this ** and ‹m > p› have "¬ m dvd p"
            using greater_hence_not_dvd
            by auto
          thus ?thesis
            by auto
        qed
      next
        case False
        hence ***: "m ≤ p"
          by simp
        then show ?thesis
        proof (cases "m = 0")
          case True
          then show ?thesis
            by auto
        next
          case False
          then show ?thesis
            using "*" "***" by auto
        qed
      qed
    qed
  qed
qed

value "prime 4"
value "prime 5"

definition true_factor :: "nat ⇒ nat ⇒ bool" where
  "true_factor x y ≡ x > 1 ∧ x < y ∧ x dvd y"

(* Svaki prost broj je veci ili jednak od 2 *)
lemma prime_greater_than_2[simp]:
  "prime x ⟶ x ≥ 2"
  by (simp add: prime_def)

(*
  Ako broj p nije prost, onda postoji z tako da vazi: 1 < z < p
  (pravi delilac) i z deli p
*)
lemma not_prime_hence_has_true_factor:
  assumes "p > 1"
  assumes "¬ prime p"
  shows "∃z. true_factor z p"
  using assms
proof-
  from ‹¬ prime p› have "p ≤ 1 ∨ (∃m∈{1..p}. m dvd p ∧ ¬ (m = 1 ∨ m = p))"
    using assms(1) assms(2) prime_code by blast
  hence "∃m∈{1..p}. m dvd p ∧ ¬ (m = 1 ∨ m = p)"
    using ‹p > 1›
    by auto
  hence "∃m∈{1..p}. m dvd p ∧ m ≠ 1 ∧ m ≠ p"
    by auto
  hence "∃m∈{1..p}. m dvd p ∧ m > 1 ∧ m < p"
    by auto
  hence "∃m∈{1..p}. true_factor m p"
    unfolding true_factor_def
    by auto
  thus ?thesis
    by auto
qed

(*
  Ako broj nije prost, onda ima prost delilac.
  Dokaz indukcijom, gde se pretpostavlja da vazi
  za sve brojeve manje od n
*)
lemma not_prime_hence_has_prime_true_factor:
  "∀p. (p ≥ 2 ∧ p ≤ n ∧ ¬ prime p) ⟶ (∃z. prime z ∧ true_factor z p)"
proof (induction n)
  case 0
  then show ?case
    by simp
next
  case (Suc n)
  show ?case
    apply (rule allI)
    apply (rule impI)
  proof-
    fix p
    assume "2 ≤ p ∧ p ≤ Suc n ∧ ¬ prime p"
    hence "2 ≤ p" "p ≤ Suc n" "¬ prime p"
      by auto
    then show "∃z. prime z ∧ true_factor z p"
    proof-
      have "¬ prime p"
        using ‹¬ prime p› by blast
      hence "∃a. true_factor a p"
        using ‹2 ≤ p› not_prime_hence_has_true_factor by auto
      then obtain a where "true_factor a p"
        by auto
      then show ?thesis
      proof (cases "prime a")
        case True
        then show ?thesis
          using ‹true_factor a p› by blast
      next
        case False
        hence "a ≤ n"
          using ‹p ≤ Suc n› ‹true_factor a p› true_factor_def by auto
        hence "∃b. prime b ∧ true_factor b a"
          using False Suc.IH ‹true_factor a p› true_factor_def by auto
        then obtain b where "prime b ∧ true_factor b a"
          by auto
        hence "true_factor b p"
          using ‹true_factor a p› less_trans true_factor_def by auto
        then show ?thesis
          using ‹prime b ∧ true_factor b a› by blast
      qed
    qed
  qed
qed

(*
   funkcija koja
   izbacuje sve mnozioce broja x
   koji su veci od broja x
   iz liste L
*)
primrec remove_multipliers :: "nat list ⇒ nat ⇒ nat list" where
  "remove_multipliers [] n = []"
| "remove_multipliers (x # xs) n = (if n dvd x ∧ x > n
                                    then remove_multipliers xs n
                                    else x # (remove_multipliers xs n))"

(*
  Lista prirodnih brojeva do n bez jedinice.
  Lista je opadajuca, kako bi dokazi indukcijom bili jednostavniji
*)
definition nlist :: "nat ⇒ nat list" where
  "nlist n = rev [2..<n+1]"

value "remove_multipliers (nlist 100) 2"
value "remove_multipliers (nlist 1) 2"
value "remove_multipliers (nlist 2) 2"

(*
  Sledi par jednostanih i neophodnih lema za
  koje se kasnije koriste
*)
lemma nlist_suc[simp]:
  assumes "n > 0"
  shows "nlist (Suc n) = (Suc n) # (nlist n)"
  unfolding nlist_def
  using assms
  by auto

lemma nlist_suc_subset[simp]:
 "set (nlist n) ⊆ set (nlist (Suc n))"
  unfolding nlist_def
  by auto

lemma remove_multipliers_remove_y_stays:
  assumes "y ∈ set ys"
  shows "y ∈ set (remove_multipliers ys y)"
  using assms
  by (induction ys) auto

lemma remove_multipliers_subset[simp]:
  "set (remove_multipliers xs y) ⊆ set xs"
  by (induction xs) auto

lemma remove_multipliers_nlist_subset[simp]:
  "set (remove_multipliers (nlist n) y) ⊆ set (nlist n)"
  by auto

lemma remove_multipliers_greater_y:
  assumes "y > n"
  shows "remove_multipliers (nlist n) y = nlist n"
  using assms
proof (induction n)
  case 0
  then show ?case
    unfolding nlist_def
    by auto
next
  case (Suc n)
  then show ?case
  proof (cases "n = 0")
    case True
    then show ?thesis
      unfolding nlist_def
      by auto
  next
    case False
    then show ?thesis
    proof-
      have "remove_multipliers (nlist (Suc n)) y
        = remove_multipliers ((Suc n) # (nlist n)) y"
        using ‹n ≠ 0›
        by auto
      also have "...  = (Suc n) # (remove_multipliers (nlist n) y)"
        using assms(1)
        by (simp add: Suc.prems nat_dvd_not_less)
      also have "... = (Suc n) # (nlist n)"
        by (simp add: Suc.IH Suc.prems Suc_lessD)
      also have "... = nlist (Suc n)"
        using False
        by auto
      finally show ?thesis
        by simp
    qed
  qed
qed

lemma remove_multipliers_nlist_suc_subset[simp]:
  "set (remove_multipliers (nlist n) y)
    ⊆ set (remove_multipliers (nlist (Suc n)) y)"
proof (cases "n > 0")
  case True
  hence *: "remove_multipliers (nlist (Suc n)) y
        = remove_multipliers ((Suc n) # (nlist n)) y"
    by simp

  case True
  then show ?thesis
  proof (cases "(Suc n) ≤ y")
    case True
    hence **: ‹¬(y dvd (Suc n) ∧ (Suc n) > y)›
      by auto
    case True
    then show ?thesis
    proof-
      from * have "remove_multipliers (nlist (Suc n)) y
            = remove_multipliers ((Suc n) # (nlist n)) y"
        by simp
      also have "... = (Suc n) # remove_multipliers (nlist n) y"
        using ‹¬(y dvd (Suc n) ∧ (Suc n) > y)›
        by auto
      also have "set ((Suc n) # remove_multipliers (nlist n) y)
            = {Suc n} ∪ set (remove_multipliers (nlist n) y)"
        by auto
      finally have "set (remove_multipliers (nlist n) y)
                     ⊆ set (remove_multipliers (nlist (Suc n)) y)"
        by auto
      thus ?thesis
        by simp
    qed
  next
    case False
    then show ?thesis
    proof (cases "y dvd (Suc n)")
      case True
      hence ***: ‹y dvd (Suc n) ∧ (Suc n) > y›
        using ‹¬ (Suc n ≤ y)›
        by auto
        case True
      then show ?thesis
      proof-
        from * have "remove_multipliers (nlist (Suc n)) y
              = remove_multipliers ((Suc n) # (nlist n)) y"
          by simp
        also have "... = remove_multipliers (nlist n) y"
          using ‹y dvd (Suc n) ∧ (Suc n) > y›
          by simp
        finally have "set (remove_multipliers (nlist n) y)
                     ⊆ set (remove_multipliers (nlist (Suc n)) y)"
        by simp
      thus  ?thesis
          by simp
      qed
    next
      case False
      hence **: ‹¬(y dvd (Suc n) ∧ (Suc n) > y)›
        by auto
      case False
      then show ?thesis
      proof-
      from * have "remove_multipliers (nlist (Suc n)) y
            = remove_multipliers ((Suc n) # (nlist n)) y"
        by simp
      also have "... = (Suc n) # remove_multipliers (nlist n) y"
        using ‹¬(y dvd (Suc n) ∧ (Suc n) > y)›
        by auto
      also have "set ((Suc n) # remove_multipliers (nlist n) y)
            = {Suc n} ∪ set (remove_multipliers (nlist n) y)"
        by auto
      finally have "set (remove_multipliers (nlist n) y)
                     ⊆ set (remove_multipliers (nlist (Suc n)) y)"
        by auto
      thus ?thesis
        by simp
      qed
    qed
  qed
next
  case False
  then show ?thesis
    unfolding nlist_def
    by auto
qed

lemma remove_multipliers_suc_subset[simp]:
  "set (remove_multipliers (nlist (Suc n)) y)
   ⊆ {Suc n} ∪ (set (remove_multipliers (nlist n) y))"
  unfolding nlist_def
  by auto

(*
  Izbacivanje svih mnozioca broja y je ekvivaletno izbacivanju
  svakog broja x > y za koji vazi da y deli x
*)
theorem remove_multipliers_theorem1:
  fixes x y n :: nat
  assumes "y ≥ 2"
  assumes "x ≤ n ∧ x > y"
  shows "x ∈ set (remove_multipliers (nlist n) y) ⟷ ¬ (y dvd x)"
  using assms
proof (induction n)
  case 0
  then show ?case
    by auto
next
  case (Suc n)
  then show ?case
  proof (cases "x = Suc n")
    case True
    then show ?thesis
    proof (cases "y dvd Suc n")
      case True
      then show ?thesis
      proof-
        have "remove_multipliers (nlist (Suc n)) y
          = remove_multipliers ((Suc n) # (nlist n)) y"
          by (metis One_nat_def True assms(1) dvd_imp_le neq0_conv nlist_suc not_less_eq_eq one_add_one plus_1_eq_Suc zero_less_Suc)
        hence "... = remove_multipliers (nlist n) y"
          using Suc.prems(2) True by auto
        have "(Suc n) ∉ set (remove_multipliers (nlist n) y)"
          by (metis Groups.add_ac(2) Suc_n_not_le_n atLeastAtMost_iff atLeastLessThanSuc_atLeastAtMost in_mono nlist_def one_add_one plus_1_eq_Suc remove_multipliers_subset set_rev set_upt)
        hence "x ∉ set (remove_multipliers (nlist n) y)"
          using ‹x = Suc n›
          by blast
        hence "x ∉ set (remove_multipliers (nlist (Suc n)) y)"
          using ‹remove_multipliers (Suc n # nlist n) y = remove_multipliers (nlist n) y› ‹remove_multipliers (nlist (Suc n)) y = remove_multipliers (Suc n # nlist n) y›
          by auto
        show ?thesis
          using Suc.IH Suc.prems(2) True ‹x ∉ set (remove_multipliers (nlist (Suc n)) y)› ‹x ∉ set (remove_multipliers (nlist n) y)› assms(1) le_Suc_eq by blast
    qed
    next
      case False
      then show ?thesis
      proof-
        have "remove_multipliers (nlist (Suc n)) y
          = remove_multipliers ((Suc n) # (nlist n)) y"
          using Suc.prems(2) assms(1) by auto
        hence "... = (Suc n) # remove_multipliers (nlist n) y"
          by (simp add: False)
        have "(Suc n) ∈ set ((Suc n) # remove_multipliers (nlist n) y)"
          by simp
        hence "x ∈ set ((Suc n) # remove_multipliers (nlist n) y)"
          using True
          by blast
        hence "x ∈ set (remove_multipliers (nlist (Suc n)) y)"
          using ‹remove_multipliers (Suc n # nlist n) y = Suc n # remove_multipliers (nlist n) y› ‹remove_multipliers (nlist (Suc n)) y = remove_multipliers (Suc n # nlist n) y›
          by auto
        thus ?thesis
          using False True by blast
      qed
    qed
  next
    case False
    hence *: "x ∈ set (remove_multipliers (nlist n) y) ⟷ ¬ (y dvd x)"
      using Suc.IH Suc.prems(2) assms(1) le_SucE by blast
    have "set (remove_multipliers (nlist (Suc n)) y)
        ⊆ {Suc n} ∪ (set (remove_multipliers (nlist n) y))"
      using remove_multipliers_suc_subset by simp
    hence "x ∈ set (remove_multipliers (nlist (Suc n)) y)
        ⟶ x = (Suc n) ∨ x ∈ set (remove_multipliers (nlist n) y)"
      by auto
    from this and ‹x ≠ Suc n› have **:
       "x ∈ set (remove_multipliers (nlist (Suc n)) y)
        ⟶ x ∈ set (remove_multipliers (nlist n) y)"
      by auto
    case False
    then show ?thesis
      using ‹x ≠ Suc n›
      using * and **
      using remove_multipliers_nlist_suc_subset
      by blast
  qed
qed

(*
  Direktna posledica prethodne teoreme:
  f-ja "remove_multipliers" ne brise proste brojeve
*)
theorem remove_multipliers_theorem1_cons:
  fixes x y n :: nat
  assumes "prime x"
  assumes "y ≥ 2"
  assumes "x ≤ n ∧ x > y"
  shows "x ∈ set (remove_multipliers (nlist n) y)"
  using assms
  using prime_def remove_multipliers_theorem1 by auto

(*
  Jaca verzija prethodne teoreme
*)
theorem remove_multipliers_theorem2:
  assumes "prime x"
  assumes "x ∈ set xs"
  assumes "x ≠ y"
  assumes "y ≥ 2"
  shows "x ∈ set (remove_multipliers xs y)"
  using assms
proof (induction xs)
  case Nil
  then show ?case
    by simp
next
  case (Cons a xs)
  then show ?case
  proof (cases "a > y")
    case True
    then show ?thesis
    proof (cases "y dvd a")
      case True
      then show ?thesis
      proof-
        from ‹a > y› and ‹y dvd a› have "y dvd a ∧ a > y"
          by simp
        hence "remove_multipliers (a # xs) y = remove_multipliers xs y"
          by auto
        also have ‹x ∈ set (remove_multipliers xs y)›
          by (metis Cons.IH Cons.prems(2) True ‹y < a› ‹y dvd a ∧ y < a› assms(1) assms(3) assms(4) less_imp_triv not_less remove_multipliers_theorem1 remove_multipliers_theorem1_cons set_ConsD)
        finally show ?thesis
          by simp
      qed
    next
      case False
      then show ?thesis
        using Cons.IH Cons.prems(2) assms(1) assms(3) assms(4) by auto
    qed
  next
    case False
    then show ?thesis
      using Cons.IH Cons.prems(2) assms(1) assms(3) assms(4) by auto
  qed
qed

(*
  Ako u listi xs postoji broj y koji je pravi delilac broja z,
  onda broj nakon uklanjanja svih mnozioca broja y,
  u listi xs se ne nalazi broj z
*)
lemma remove_multipliers_true_factor:
  assumes "true_factor z y"
  shows "y ∉ set (remove_multipliers xs z)"
  using assms
proof (induction xs)
  case Nil
  then show ?case
    by auto
next
  case (Cons a xs)
  then show ?case
  proof (cases "a = y")
    case True
    then show ?thesis
      using Cons.IH assms true_factor_def by auto
  next
    case False
    then show ?thesis
      using Cons.IH assms by auto
  qed
qed

(* Erastostenovo Sito *)
(*
  erast' je pomocna f-ja preko
  koje se definise f-ja za Erastostenovo sito
*)
primrec erast' :: "nat list ⇒ nat list ⇒ nat list" where
  "erast' [] ys = ys"
| "erast' (x # xs) ys = (let es = erast' xs ys
                         in (if x ∈ set es
                             then remove_multipliers es x
                             else es))"
(*
  Posto je (nlist n) opadajuca f-ja,
  rezultat se rotira kako bi bio rastuci
*)
definition erast :: "nat ⇒ nat list" where
  "erast n = rev (erast' (nlist n) (nlist n))"

value "erast 100"

lemma erast_0:
  "erast 0 = []"
  unfolding erast_def nlist_def
  by auto

(*
  Vazi sledece:
  set (erast' [a1, a2, ..., an] bs)
  ⊆ set (erast' [a2, ..., an] bs)
  ...
  ⊆ set (erast' [an] bs)
  ⊆ set (erast' [] bs)
  = bs
*)
lemma erast'_next_sub:
  "set (erast' (x # xs) ys) ⊆ set (erast' xs ys)"
proof (cases "x ∈ set (erast' xs ys)")
  case True
  then show ?thesis
  proof-
    have "erast' (x # xs) ys = remove_multipliers (erast' xs ys) x"
      using True
      by auto
    hence "set (erast' (x # xs) ys) ⊆ set (remove_multipliers (erast' xs ys) x)"
      by auto
    thus "set (erast' (x # xs) ys) ⊆ set (erast' xs ys)"
      using remove_multipliers_subset
      by blast
  qed
next
  case False
  then show ?thesis
    by auto
qed

(*
  Direktna posledica prethodne leme
*)
lemma erast'_nlist_sub:
  "set (erast' xs ys) ⊆ set ys"
proof (induction xs)
  case Nil
  then show ?case
    by auto
next
  case (Cons a xs)
  then show ?case
    by (meson dual_order.trans erast'_next_sub)
qed

(*
  Specijalan slucaj prethodne leme koji se cesce koristi
*)
lemma erast_nlist_sub:
  "set (erast n) ⊆ set (nlist n)"
  unfolding erast_def
  by (simp add: erast'_nlist_sub)

(*
  F-ja erast (tj. erast') ne brise proste brojeve iz list
  tj. oni uvek opstaju

  Ovo predstavlja jednu od kljucnih lema u dokazu korektnosti
  Erastostenovog sita
*)
lemma erast'_prime_stays:
  assumes "prime y"
  assumes "y ∈ set ys"
  shows "y ∈ set (erast' (nlist n) ys)"
proof (induction n)
  case 0
  then show ?case
    unfolding nlist_def
    by (simp add: assms(2))
next
  case (Suc n)
  then show ?case
  proof (cases "n = 0")
    case True
    then show ?thesis
      unfolding nlist_def
      by (simp add: assms(2))
  next
    case False
    hence *: "erast' (nlist (Suc n)) ys = erast' ((Suc n) # (nlist n)) ys"
      by simp
    case False
    then show ?thesis
    proof (cases "(Suc n) ∈ set (erast' (nlist n) ys)")
      case True
      from this and * have **: "erast' (nlist (Suc n)) ys =
        remove_multipliers (erast' (nlist n) ys) (Suc n)"
        by simp
      case True
      then show ?thesis
      proof (cases "y = Suc n")
        case True
        then show ?thesis
        proof-
          from ‹y = Suc n› and ‹y ∈ set (erast' (nlist n) ys)› have
            "y ∈ set (remove_multipliers (erast' (nlist n) ys) (Suc n))"
            using remove_multipliers_remove_y_stays
            by simp
          from this and ** show ?thesis
            by simp
        qed
      next
        case False
        then show ?thesis
          using "**" Suc.IH assms(1) nlist_def remove_multipliers_theorem2 by fastforce
      qed
    next
      case False
      hence "erast' (nlist (Suc n)) ys = erast' (nlist n) ys"
        by (simp add: "*")
      case False
      then show ?thesis
        by (simp add: Suc.IH ‹erast' (nlist (Suc n)) ys = erast' (nlist n) ys›)
    qed
  qed
qed

(*
  Posledica prethodne leme
  Predstavlja jedan kljucni smer u dokazu korektnosti Erastostenovog sita
*)
theorem erast_prime_stays:
  assumes "prime y"
  assumes "y ≤ n"
  shows "y ∈ set (erast n)"
  using assms
proof (induction n)
case 0
  then show ?case
    using prime_def by blast
next
  case (Suc n)
  then show ?case
  proof-
    have "y ∈ set (nlist (Suc n))"
      by (metis (full_types) One_nat_def Suc.IH Suc.prems(2) assms(1) erast_nlist_sub le_SucE list.set_intros(1) nat_less_le nlist_suc nlist_suc_subset prime_def subset_eq zero_less_Suc)
    hence "y ∈ set (erast' (nlist (Suc n)) (nlist (Suc n)))"
      using assms(1) erast'_prime_stays by blast
    thus "y ∈ set (erast (Suc n))"
      by (simp add: erast_def)
  qed
qed

lemma erast'_less_than_n:
  assumes "y ∈ set (erast' (nlist n) (nlist n))"
  shows "y ≤ n"
  using assms erast'_nlist_sub nlist_def by fastforce

(*
  Svi brojevi u Erastostenovom situ su
  izmedju 2 i n, gde je n zadati parametar f-je
*)
lemma erast_y_less_than_n:
  assumes "y ∈ set (erast' (nlist n) (nlist n))"
  shows "y > 1 ∧ y ≤ n"
proof-
  from assms have "y ∈ set (nlist n)"
    using erast'_nlist_sub by blast
  thus "y > 1 ∧ y ≤ n"
    using nlist_def
    by auto
qed

(*
  Direktna posledica lema: erast'_next_sub
*)
lemma erast'_less_removals_sub:
  shows "set (erast' (cs @ as) ys) ⊆ set (erast' as ys)"
proof (induction cs)
  case Nil
  then show ?case
    by simp
next
  case (Cons c cs)
  then show ?case
  proof (cases "c ∈ set(erast' (cs @ as) ys)")
    case True
    then show ?thesis
      by (metis Cons.IH append_Cons dual_order.trans erast'_next_sub)
  next
    case False
    then show ?thesis
      using Cons.IH by auto
  qed

qed

(*
  Ako broj ima prost delilac, onda on ce on
  biti izbrisan u Erastostenovom situ
*)
lemma erast_prime_true_factor_deletes:
  assumes "prime z"
  assumes "true_factor z y"
  assumes "y ≤ n"
  shows "y ∉ set (erast n)"
  using assms
proof-
  have "z ∈ set (nlist n)"
    by (meson assms(1) assms(2) assms(3) erast_nlist_sub erast_prime_stays less_imp_le_nat less_le_trans subset_iff true_factor_def)
  hence "z ∈ set (erast n)"
    using assms(1) assms(2) assms(3) erast_prime_stays true_factor_def by auto
  from ‹z ∈ set (nlist n)› have "∃as bs. (nlist n) = as @ [z] @ bs"
    by (simp add: split_list)
  then obtain as bs where "(nlist n) = as @ [z] @ bs"
    by auto
  hence "set ([z] @ bs) ⊆ set (as @ [z] @ bs)"
    by (simp add: subset_iff)
  have "set (erast' (nlist n) (nlist n)) = set(erast' (as @ [z] @ bs) (nlist n))"
    using ‹nlist n = as @ [z] @ bs› by auto
  hence "... ⊆ set(erast' ([z] @ bs) (nlist n))"
    using erast'_less_removals_sub by blast
  have "z ∈ set(erast' bs (nlist n))"
    by (metis Cons_eq_appendI ‹nlist n = as @ [z] @ bs› ‹set (erast' (as @ [z] @ bs) (nlist n)) ⊆ set (erast' ([z] @ bs) (nlist n))› ‹z ∈ set (nlist n)› append_self_conv2 assms(1) erast'_next_sub erast'_prime_stays in_mono)
  hence "erast' ([z] @ bs) (nlist n)
     = remove_multipliers (erast' bs (nlist n)) z"
    by auto
  hence "y ∉ set (remove_multipliers (erast' bs (nlist n)) z)"
    using assms(2) remove_multipliers_true_factor by blast
  hence "y ∉ set (erast' ([z] @ bs) (nlist n))"
    using ‹erast' ([z] @ bs) (nlist n) = remove_multipliers (erast' bs (nlist n)) z› by auto
  thus "y ∉ set (erast n)"
    using ‹nlist n = as @ [z] @ bs› ‹set (erast' (as @ [z] @ bs) (nlist n)) ⊆ set (erast' ([z] @ bs) (nlist n))› erast_def by auto
qed

(*
  Opstiji slucaj prethodne leme (z ne mora da bude prost broj)
*)
lemma erast_true_factor_deletes:
  assumes "true_factor z y"
  assumes "y ≤ n"
  shows "y ∉ set (erast n)"
  using assms
proof (cases "prime z")
  case True
  then show ?thesis
    using assms(1) assms(2) erast_prime_true_factor_deletes by blast
next
  case False
  hence "∃s. true_factor s z ∧ prime s"
    by (metis (full_types) One_nat_def Suc_1 Suc_leI assms(1) le_refl not_prime_hence_has_prime_true_factor true_factor_def)
 then obtain s where "true_factor s z ∧ prime s"
    by auto
  hence "true_factor s y"
    using assms(1) less_trans true_factor_def by auto
  then show ?thesis
    using ‹true_factor s z ∧ prime s› assms(2) erast_prime_true_factor_deletes by blast
qed

(*
  Prosti brojevi ostaju u Erastostenovom situ
*)
lemma erast'_keeps_prime:
  assumes "y ≤ n"
  assumes "y ∈ set (erast' (nlist n) (nlist n))"
  shows "prime y"
  apply (rule ccontr)
proof-
  assume "¬ prime y"
  then show False
  proof-
    from ‹¬ prime y› have "∃z. true_factor z y"
      unfolding true_factor_def
      by (metis assms(2) atLeastAtMost_iff erast_y_less_than_n le_neq_implies_less prime_code)
    then obtain z where "true_factor z y"
      by auto
    hence "z ∈ set (nlist n)"
      unfolding true_factor_def
      using assms(1) nlist_def by auto
    hence "y ∉ set (erast' (nlist n) (nlist n))"
      using true_factor_def
      using ‹true_factor z y› assms(1) erast_def erast_true_factor_deletes by auto
    from this and assms show "False"
      by auto
  qed
qed

(*
  Ekvivaletno prethodnoj lemi (posledica)
  Predstavlja drugi kljucni smer u dokazivanju korektnosti
  Erastostenovog sita
*)
theorem erast_keeps_prime:
  assumes "y ∈ set (erast n)"
  shows "prime y"
  using assms erast'_keeps_prime erast_def erast_y_less_than_n by auto

(*
  Broj x se nalazi u Erastostenovom situ
    akko
  broj x je prost broj
*)
theorem erast_prime:
  fixes x n :: nat
  assumes "x ≤ n"
  shows "x ∈ set (erast n) ⟷ prime x"
  using assms
  using erast_keeps_prime erast_prime_stays by blast

export_code erast in Haskell

end


(*  Title:       Proving the Correctness of Disk Paxos

    Author:      Mauro J. Jaskelioff, Stephan Merz, 2005
    Maintainer:  Mauro J. Jaskelioff <mauro at fceia.unr.edu.ar>
*)

theory DiskPaxos_Invariant imports DiskPaxos_Inv6 begin

subsection \<open>The Complete Invariant\<close>

definition HInv :: "state \<Rightarrow> bool"
where
  "HInv s =  (HInv1 s
            \<and> HInv2 s
            \<and> HInv3 s
            \<and> HInv4 s
            \<and> HInv5 s
            \<and> HInv6 s)"

theorem I1:
  "HInit s \<Longrightarrow> HInv s"
  using HInit_HInv1 HInit_HInv2 HInit_HInv3
        HInit_HInv4 HInit_HInv5 HInit_HInv6
  by(auto simp add: HInv_def)

theorem I2:
  assumes inv:  "HInv s"
  and nxt: "HNext s s'"
  shows "HInv s'"
  using inv I2a[OF nxt] I2b[OF nxt] I2c[OF nxt]
            I2d[OF nxt] I2e[OF nxt] I2f[OF nxt]
  by(simp add: HInv_def)

end


(*File: VDM.thy*)
(*Authors: Lennart Beringer and Martin Hofmann, LMU Munich 2008*)
theory VDM imports IMP begin
section{*Program logic*}

text{*\label{sec:VDM} The program logic is a partial correctness logic
in (precondition-less) VDM style. This means that assertions are
binary predicates over states and relate the initial and final
states of a terminating execution.*}

subsection {*Assertions and their semantic validity*}

text{*Assertions are binary predicates over states, i.e.~are of type*}

type_synonym "VDMAssn" = "State \<Rightarrow> State \<Rightarrow> bool"

text{*Command $c$ satisfies assertion $A$ if all (terminating)
operational behaviours are covered by the assertion.*}

definition VDM_valid :: "IMP \<Rightarrow> VDMAssn \<Rightarrow> bool"
                       (" \<Turnstile> _ : _ " [100,100] 100)
where "\<Turnstile> c : A = (\<forall> s t . (s,c \<Down> t) \<longrightarrow> A s t)"

text{*A variation of this property for the height-indexed operational
semantics,\ldots*}

definition VDM_validn :: "nat \<Rightarrow> IMP \<Rightarrow> VDMAssn \<Rightarrow> bool"
                        (" \<Turnstile>\<^sub>_ _ : _ " [100,100,100] 100)
where "\<Turnstile>\<^sub>n c : A = (\<forall> m . m \<le> n --> (\<forall> s t . (s,c \<rightarrow>\<^sub>m t) --> A s t))"

text{*\ldots plus the obvious relationships.*}
lemma VDM_valid_validn: "\<Turnstile> c:A \<Longrightarrow> \<Turnstile>\<^sub>n c:A"
(*<*)
by (simp add: VDM_valid_def VDM_validn_def Sem_def, fastforce)
(*>*)

lemma VDM_validn_valid: "(\<forall> n . \<Turnstile>\<^sub>n c:A) \<Longrightarrow> \<Turnstile> c:A"
(*<*)
by (simp add: VDM_valid_def VDM_validn_def Sem_def, fastforce)
(*>*)

lemma VDM_lowerm: "\<lbrakk> \<Turnstile>\<^sub>n c:A; m \<le> n \<rbrakk> \<Longrightarrow> \<Turnstile>\<^sub>m c:A"
(*<*)
apply (simp add: VDM_validn_def, clarsimp)
apply (erule_tac x="ma" in allE, simp)
done
(*>*)

text{*Proof contexts are simply sets of assertions -- each entry
represents an assumption for the unnamed procedure. In particular, a
context is valid if each entry is satisfied by the method call
instruction.*}

definition Ctxt_valid :: "VDMAssn set \<Rightarrow> bool" (" \<Turnstile> _ " [100] 100)
where "\<Turnstile> G = (\<forall> A . A \<in> G \<longrightarrow> (\<Turnstile> Call : A))"

text{*Again, a relativised sibling \ldots*}

definition Ctxt_validn :: "nat \<Rightarrow> (VDMAssn set) \<Rightarrow> bool"
                         (" \<Turnstile>\<^sub>_ _  " [100,100] 100)
where "\<Turnstile>\<^sub>n G = (\<forall> m . m \<le> n \<longrightarrow> (\<forall> A. A \<in> G \<longrightarrow> ( \<Turnstile>\<^sub>m Call : A)))"

text{*satisfies the obvious properties.*}

lemma Ctxt_valid_validn: "\<Turnstile> G \<Longrightarrow> \<Turnstile>\<^sub>n G"
(*<*)
apply (simp add: Ctxt_valid_def Ctxt_validn_def, clarsimp)
apply (rule VDM_valid_validn) apply fast
done
(*>*)

lemma Ctxt_lowerm: "\<lbrakk> \<Turnstile>\<^sub>n G; m < n \<rbrakk> \<Longrightarrow> \<Turnstile>\<^sub>m G"
(*<*)
by (simp add: Ctxt_validn_def)
(*>*)

text{*A judgement is valid if the validity of the context implies that
of the commmand-assertion pair.*}

definition valid :: "(VDMAssn set) \<Rightarrow> IMP \<Rightarrow> VDMAssn \<Rightarrow> bool"
                    ("_ \<Turnstile> _ : _ " [100,100,100] 100)
where "G \<Turnstile> c : A = (\<Turnstile> G \<longrightarrow> \<Turnstile> c : A)"

text{*And, again, a relatived notion of judgement validity.*}

definition validn ::
 "(VDMAssn set) \<Rightarrow> nat \<Rightarrow> IMP \<Rightarrow> VDMAssn \<Rightarrow> bool"
  ("_ \<Turnstile>\<^sub>_ _ : _" [100,100,100,100] 100)
where "G \<Turnstile>\<^sub>n c : A = (\<Turnstile>\<^sub>n G \<longrightarrow> \<Turnstile>\<^sub>n c : A)"

lemma validn_valid: "(\<forall> n . G \<Turnstile>\<^sub>n c : A) \<Longrightarrow> G \<Turnstile> c : A"
(*<*)
apply (simp add: valid_def validn_def, clarsimp)
apply (rule VDM_validn_valid, clarsimp)
apply (erule_tac x=n in allE, erule mp)
apply (erule Ctxt_valid_validn)
done
(*>*)

lemma ctxt_consn: "\<lbrakk> \<Turnstile>\<^sub>n G;  \<Turnstile>\<^sub>n Call:A \<rbrakk> \<Longrightarrow> \<Turnstile>\<^sub>n ({A} \<union> G)"
(*<*)
apply (simp add: Ctxt_validn_def)  apply clarsimp
apply (erule_tac x=m in allE, clarsimp)
apply (erule VDM_lowerm) apply assumption
done
(*>*)

subsection{*Proof system*}

inductive_set
  VDM_proof :: "(VDMAssn set \<times> IMP \<times> VDMAssn) set"
where

VDMSkip:   "(G, Skip, \<lambda> s t . t=s) : VDM_proof"

| VDMAssign:
  "(G, Assign x e, \<lambda> s t . t = (update s x (evalE e s))) : VDM_proof"

| VDMComp:
  "\<lbrakk> (G, c1, A1) : VDM_proof; (G, c2, A2) : VDM_proof\<rbrakk> \<Longrightarrow>
   (G, Comp c1 c2, \<lambda> s t . \<exists> r . A1 s r \<and> A2 r t) : VDM_proof"

| VDMIff:
  "\<lbrakk> (G, c1, A):VDM_proof; (G, c2, B):VDM_proof\<rbrakk> \<Longrightarrow>
   (G, Iff b c1 c2, \<lambda> s t . (((evalB b s) \<longrightarrow> A s t) \<and>
                                    ((\<not> (evalB b s)) \<longrightarrow> B s t))) : VDM_proof"

(*VDMWhile:  "\<lbrakk>\<rhd> C : (\<lambda> s t . (evalB b s \<longrightarrow> I s t)); Trans I; Refl I\<rbrakk>
            \<Longrightarrow> \<rhd> (While b C) : (\<lambda> s t . I s t \<and> \<not> (evalB b t))"*)
| VDMWhile:
  "\<lbrakk> (G, c, B):VDM_proof;  \<forall> s . (\<not> evalB b s) \<longrightarrow> A s s;
             \<forall> s r t. evalB b s \<longrightarrow> B s r \<longrightarrow> A r t \<longrightarrow> A s t \<rbrakk> \<Longrightarrow>
   (G, While b c, \<lambda> s t . A s t \<and> \<not> (evalB b t)) : VDM_proof"

| VDMCall:
  "({A} \<union> G, body, A):VDM_proof \<Longrightarrow> (G, Call, A):VDM_proof"

| VDMAx: "A \<in> G \<Longrightarrow>  (G, Call, A):VDM_proof"

| VDMConseq:
  "\<lbrakk> (G, c, A):VDM_proof; \<forall> s t. A s t \<longrightarrow> B s t\<rbrakk> \<Longrightarrow>
   (G, c, B):VDM_proof"
(*
VDMSkip:   "G \<rhd> Skip : (\<lambda> s t . t=s)"
VDMAssign: "G \<rhd> (Assign x e) : (\<lambda> s t . t = (update s x (evalE e s)))"
VDMComp:   "\<lbrakk> G \<rhd> c1:A1; G \<rhd> c2:A2\<rbrakk>
           \<Longrightarrow> G \<rhd> (Comp c1 c2) : (\<lambda> s t . \<exists> r . A1 s r \<and> A2 r t)"
VDMIff:    "\<lbrakk> G \<rhd> c1 : A; G \<rhd> c2 :B\<rbrakk>
            \<Longrightarrow> G \<rhd> (Iff b c1 c2) : (\<lambda> s t . (((evalB b s) \<longrightarrow> A s t) \<and>
                                             ((\<not> (evalB b s)) \<longrightarrow> B s t)))"
(*VDMWhile:  "\<lbrakk>\<rhd> C : (\<lambda> s t . (evalB b s \<longrightarrow> I s t)); Trans I; Refl I\<rbrakk>
            \<Longrightarrow> \<rhd> (While b C) : (\<lambda> s t . I s t \<and> \<not> (evalB b t))"*)
VDMWhile:  "\<lbrakk> G \<rhd> c : B;
              \<forall> s . (\<not> evalB b s) \<longrightarrow> A s s;
              \<forall> s r t. evalB b s \<longrightarrow> B s r \<longrightarrow> A r t \<longrightarrow> A s t \<rbrakk>
            \<Longrightarrow> G \<rhd> (While b c) : (\<lambda> s t . A s t \<and> \<not> (evalB b t))"
VDMCall: "({A} \<union> G) \<rhd> body : A \<Longrightarrow> G \<rhd> Call : A"
VDMAx: "A \<in> G \<Longrightarrow>  G \<rhd> Call : A"
VDMConseq: "\<lbrakk> G \<rhd> c : A; \<forall> s t. A s t \<longrightarrow> B s t\<rbrakk> \<Longrightarrow> G \<rhd> c : B"
*)

abbreviation
  VDM_deriv :: "[VDMAssn set, IMP, VDMAssn] \<Rightarrow> bool"
                ("_ \<rhd> _ : _" [100,100,100] 100)
where "G \<rhd> c : A == (G,c,A) \<in> VDM_proof"

text{*The while-rule is in fact inter-derivable with the following rule.*}

lemma Hoare_While:
   "G \<rhd> c : (\<lambda> s s' . \<forall> r . evalB b s \<longrightarrow> I s r \<longrightarrow> I s' r) \<Longrightarrow>
    G \<rhd> While b c : (\<lambda> s s'. \<forall> r . I s r \<longrightarrow> (I s' r \<and> \<not> evalB b s'))"
apply (subgoal_tac "G \<rhd> (While b c) :
           (\<lambda> s t . (\<lambda> s t . \<forall>r. I s r \<longrightarrow> I t r) s t \<and> \<not> (evalB b t))")
apply (erule VDMConseq)
apply simp
apply (rule VDMWhile) apply assumption apply simp apply simp
done

text{*Here's the proof in the opposite direction.*}

subsection{*Soundness*}
(*<*)
lemma MAX:"Suc (max k m) \<le> n \<Longrightarrow> k \<le> n \<and> m \<le> n"
by (simp add: max_def, case_tac "k \<le> m", simp+)
(*>*)

(*<*)
definition SoundWhileProp::"nat \<Rightarrow> (VDMAssn set) \<Rightarrow> IMP \<Rightarrow> VDMAssn \<Rightarrow> BExpr \<Rightarrow> VDMAssn \<Rightarrow> bool"
where "SoundWhileProp n G c B b A =
   ((\<forall>m. G \<Turnstile>\<^sub>m c : B) \<longrightarrow> (\<forall>s. (\<not> evalB b s) \<longrightarrow> A s s) \<longrightarrow>
    (\<forall>s. evalB b s \<longrightarrow> (\<forall>r. B s r \<longrightarrow> (\<forall>t. A r t \<longrightarrow> A s t))) \<longrightarrow>
   G \<Turnstile>\<^sub>n (While b c) : (\<lambda>s t. A s t \<and> \<not> evalB b t))"

lemma SoundWhileAux[rule_format]: "SoundWhileProp n G c B b A"
apply (induct n)
apply (simp_all add: SoundWhileProp_def)
apply clarsimp apply (simp add: validn_def VDM_validn_def, clarsimp)
  apply (drule Sem_no_zero_height_derivs) apply simp
apply clarsimp apply (simp add: validn_def VDM_validn_def, clarsimp)
  apply (erule Sem_eval_cases)
  prefer 2 apply clarsimp
  apply clarsimp
   apply (erule_tac x=n in allE, erule impE) apply (erule Ctxt_lowerm) apply simp
   apply (rotate_tac -1)
   apply (erule_tac x=ma in allE, clarsimp)
   apply(erule impE) apply (erule Ctxt_lowerm) apply simp
   apply (erule_tac x=na in allE, clarsimp) apply fast
done
(*>*)

text{*An auxiliary lemma stating the soundness of the while rule. Its
proof is by induction on $n$.*}

lemma SoundWhile[rule_format]:
  "(\<forall>m. G \<Turnstile>\<^sub>m c : B) \<longrightarrow> (\<forall>s. (\<not> evalB b s) \<longrightarrow> A s s) \<longrightarrow>
    (\<forall>s. evalB b s \<longrightarrow> (\<forall>r. B s r \<longrightarrow> (\<forall>t. A r t \<longrightarrow> A s t))) \<longrightarrow>
   G \<Turnstile>\<^sub>n (While b c) : (\<lambda>s t. A s t \<and> \<not> evalB b t)"
(*<*)
apply (subgoal_tac "SoundWhileProp n G c B b A")
  apply (simp add: SoundWhileProp_def)
apply (rule SoundWhileAux)
done
(*>*)

text{*Similarly, an auxiliary lemma for procedure invocations. Again,
the proof proceeds by induction on $n$.*}

lemma SoundCall[rule_format]:
"\<lbrakk>\<forall>n. \<Turnstile>\<^sub>n ({A} \<union> G) \<longrightarrow> \<Turnstile>\<^sub>n body : A\<rbrakk> \<Longrightarrow> \<Turnstile>\<^sub>n G \<longrightarrow> \<Turnstile>\<^sub>n Call : A"
(*<*)
apply (induct_tac n)
apply (simp add: VDM_validn_def, clarsimp)
  apply (drule Sem_no_zero_height_derivs) apply simp
apply clarsimp
  apply (drule Ctxt_lowerm) apply (subgoal_tac "n < Suc n", assumption) apply simp apply clarsimp
  apply (drule ctxt_consn) apply assumption
  apply (simp add: VDM_validn_def, clarsimp)
  apply (erule Sem_eval_cases, clarsimp)
done
(*>*)

text{*The heart of the soundness proof is the following lemma which is
proven by induction on the judgement $G \rhd c :A$.*}

text{*Combining this result with lemma @{text
validn_valid}, we obtain soundness in contexts,\ldots*}

theorem VDM_Sound: "G \<rhd> c: A \<Longrightarrow> G \<Turnstile> c:A"
(*<*)
by (drule VDM_Sound_n, erule validn_valid)
(*>*)

text{*\ldots and consequently soundness w.r.t.~empty
contexts.*}

lemma VDM_Sound_emptyCtxt:"{} \<rhd> c : A \<Longrightarrow> \<Turnstile> c : A"
(*<*)
apply (drule VDM_Sound)
apply (simp add: valid_def, erule mp)
apply (simp add: Ctxt_valid_def)
done
(*>*)

subsection{*Admissible rules*}

text{*A weakening rule and some cut rules are easily derived.*}

lemma WEAK[rule_format]:
  "G \<rhd> c : A \<Longrightarrow> (\<forall> H . G \<subseteq> H \<longrightarrow> H \<rhd> c :A)"
(*<*)
apply (erule VDM_proof.induct)
apply clarsimp apply (rule VDMSkip)
apply clarsimp apply (rule VDMAssign)
apply clarsimp apply (rule VDMComp) apply (erule_tac x=H in allE, simp) apply (erule_tac x=H in allE, simp)
apply clarsimp apply (rule VDMIff)  apply (erule_tac x=H in allE, simp) apply (erule_tac x=H in allE, simp)
apply clarsimp apply (rule VDMWhile) apply (erule_tac x=H in allE, simp)  apply (assumption) apply simp
apply clarsimp apply (rule VDMCall) apply (erule_tac x="({A} \<union> H)" in allE, simp) apply fast
apply clarsimp apply (rule VDMAx) apply fast
apply clarsimp apply (rule VDMConseq) apply (erule_tac x=H in allE, clarsimp) apply assumption apply assumption
done
(*>*)

(*<*)
definition CutAuxProp::"VDMAssn set \<Rightarrow> IMP \<Rightarrow> VDMAssn \<Rightarrow> bool"
where "CutAuxProp H c A =
  (\<forall> G P D . (H = (insert P D) \<longrightarrow> G \<rhd> Call :P \<longrightarrow> (G \<subseteq> D) \<longrightarrow> D \<rhd> c:A))"

lemma CutAux1:"(H \<rhd> c : A) \<Longrightarrow> CutAuxProp H c A"
apply (erule VDM_proof.induct)
apply (simp_all add: add: CutAuxProp_def)
apply clarify
apply (fast intro: VDMSkip)
apply (fast intro: VDMAssign)
apply clarsimp
  apply (erule_tac x=Ga in allE) apply (erule_tac x=Ga in allE)
  apply (erule_tac x=P in allE) apply (erule_tac x=P in allE)
  apply (erule_tac x=D in allE, simp) apply (erule_tac x=D in allE, simp)
  apply (rule VDMComp) apply assumption+
apply clarsimp
  apply (erule_tac x=Ga in allE) apply (erule_tac x=Ga in allE)
  apply (erule_tac x=P in allE) apply (erule_tac x=P in allE)
  apply (erule_tac x=D in allE, simp) apply (erule_tac x=D in allE, simp)
  apply (rule VDMIff) apply assumption+
apply clarsimp
  apply (erule_tac x=Ga in allE)
  apply (erule_tac x=P in allE)
  apply (erule_tac x=D in allE, simp)
  apply (rule VDMWhile) apply assumption+
  apply simp
apply clarsimp
  apply (erule_tac x=Ga in allE)
  apply (erule_tac x=P in allE)
  apply (erule_tac x="insert A D" in allE, simp)
  apply (rule VDMCall) apply fastforce
apply clarsimp
  apply (erule disjE)
  apply clarsimp apply (erule WEAK) apply assumption
  apply (erule VDMAx)
apply clarsimp
apply (subgoal_tac "D \<rhd>  c : A")
apply (erule VDMConseq) apply assumption
  apply simp
done
(*>*)

lemma CutAux:
  "\<lbrakk>H \<rhd> c : A; H = insert P D; G \<rhd> Call :P; G \<subseteq> D\<rbrakk> \<Longrightarrow> D \<rhd> c:A"
(*<*)
by (drule CutAux1, simp add: CutAuxProp_def)
(*>*)

lemma Cut:"\<lbrakk> G \<rhd> Call : P ; (insert P G) \<rhd> c : A \<rbrakk> \<Longrightarrow> G \<rhd> c : A"
(*<*)
apply (rotate_tac -1, drule CutAux)
apply (fastforce, assumption)
apply (simp, assumption)
done
(*>*)

text{*We call context $G$ verified if all entries are justified by
derivations for the procedure body.*}

definition verified::"VDMAssn set \<Rightarrow> bool"
where "verified G = (\<forall> A . A:G \<longrightarrow> G \<rhd> body : A)"

text{*The property is preserved by sub-contexts*}

lemma verified_preserved: "\<lbrakk>verified G; A:G\<rbrakk> \<Longrightarrow> verified (G - {A})"
(*<*)
apply (simp add: verified_def, (rule allI)+, rule)
apply (subgoal_tac "(G - {A}) \<rhd> Call:A")
(*now use the subgoal (G - {A}) \<rhd> Call:A to prove the goal*)
apply (subgoal_tac "G = insert A (G - {A})") prefer 2 apply fast
apply (erule_tac x=Aa in allE)
apply (erule impE, simp)
apply (erule Cut)  apply simp
(* now prove the subgoal (G - {A}) \<rhd>  Call : A *)
  apply (erule_tac x=A in allE, clarsimp)
  apply (rule VDMCall) apply simp apply (erule WEAK) apply fast
done
(*>*)

(*<*)
lemma SetNonSingleton:
  "\<lbrakk>G \<noteq> {A}; A \<in> G\<rbrakk> \<Longrightarrow> \<exists>B. B \<noteq> A \<and> B \<in> G"
by auto

text{*The @{text Mutrec} rule allows us to eliminate verified (finite)
contexts. Its proof proceeds by induction on $n$. *}

theorem Mutrec:
"\<lbrakk> finite G; card G = n; verified G; A : G \<rbrakk> \<Longrightarrow> {} \<rhd> Call:A"
(*<*)
by (rule MutrecAux, fast)
(*>*)

text{*In particular, @{text Mutrec} may be used to show that verified
finite contexts are valid.*}

lemma Ctxt_verified_valid: "\<lbrakk>verified G; finite G\<rbrakk> \<Longrightarrow> \<Turnstile> G"
(*<*)
apply (subgoal_tac "(\<forall> A . A:G \<longrightarrow> G \<rhd> body : A)")
prefer 2 apply (simp add: verified_def)
apply (simp add: Ctxt_valid_def, clarsimp)
apply (erule_tac x=A in allE, simp)
apply (rule VDM_Sound_emptyCtxt)
apply (subgoal_tac "card G = card G")
apply (rule Mutrec, assumption)  apply assumption+ apply simp
(*  apply (simp add: card_def)*)
done
(*>*)

subsection{*Completeness*}

text{*Strongest specifications, given precisely by the operational
behaviour.*}

definition SSpec::"IMP \<Rightarrow> VDMAssn"
where "SSpec c s t = s,c \<Down> t"

text{*Strongest specifications are valid \ldots*}
lemma SSpec_valid: "\<Turnstile> c : (SSpec c)"
(*<*)by (simp add: VDM_valid_def SSpec_def)(*>*)

text{*and imply any other valid assertion for the same program (hence
their name).*}

lemma SSpec_strong: "\<Turnstile> c :A \<Longrightarrow> \<forall> s t . SSpec c s t \<longrightarrow> A s t"
(*<*)by (simp add: VDM_valid_def SSpec_def)(*>*)

text{*By induction on $c$ we show the following.*}

lemma SSpec_derivable:"G \<rhd> Call : SSpec Call \<Longrightarrow> G \<rhd> c : SSpec c"
(*<*)
apply (induct c)
  apply (rule VDMConseq)
  apply (rule VDMSkip) apply (simp add: SSpec_def Sem_def, rule, rule) apply (rule SemSkip)
  apply (rule VDMConseq)
  apply (rule VDMAssign) apply (simp add: SSpec_def Sem_def, rule, rule) apply (rule SemAssign) apply simp
apply clarsimp
  apply (rule VDMConseq)
  apply (rule VDMComp) apply assumption+ apply (simp add: SSpec_def Sem_def, clarsimp)
  apply rule apply (rule SemComp) apply assumption+ apply simp
apply clarsimp
apply (rename_tac BExpr c)
apply (rule VDMConseq)
  apply (erule VDMWhile)
    prefer 3 apply (subgoal_tac "\<forall>s t. SSpec (While BExpr c) s t \<and> \<not> evalB BExpr t \<longrightarrow> SSpec (While BExpr c) s t", assumption)
    apply simp
    apply (simp add: SSpec_def Sem_def, clarsimp) apply (rule, erule SemWhileF) apply simp
    apply (simp add: SSpec_def Sem_def, clarsimp) apply (rule, erule SemWhileT) apply assumption+ apply simp
apply clarsimp
apply (rule VDMConseq)
  apply (rule VDMIff) apply assumption+ apply (simp add: SSpec_def Sem_def, clarsimp)
  apply (erule thin_rl, erule thin_rl)
  apply (rename_tac BExpr c1 c2 s t)
  apply (case_tac "evalB BExpr s")
  apply clarsimp apply (rule, rule SemTrue) apply assumption+
  apply clarsimp apply (rule, rule SemFalse) apply (assumption, assumption)
apply assumption
done
(*>*)

text{*The (singleton) strong context contains the strongest
specification of the procedure.*}

definition StrongG :: "VDMAssn set"
where "StrongG = {SSpec Call}"

text{*By construction, the strongest specification of the procedure's
body can be verified with respect to this context.*}

lemma StrongG_Body: "StrongG \<rhd> body : SSpec Call"
(*<*)
apply (subgoal_tac "StrongG \<rhd> body : SSpec body")
  apply (erule VDMConseq) apply (simp add: SSpec_def Sem_def, clarsimp)
  apply (rule, erule SemCall)
apply (rule SSpec_derivable) apply (rule VDMAx) apply (simp add: StrongG_def)
done
(*>*)

text{*Thus, the strong context is verified.*}

lemma StrongG_verified: "verified StrongG"
(*<*)
apply (simp add: verified_def)
apply (rule allI)+
apply rule
apply (subgoal_tac "StrongG \<rhd> body : SSpec Call")
apply (simp add: StrongG_def)
apply (rule StrongG_Body)
done
(*>*)

text{*Using this result and the rules @{text Cut} and @{text Mutrec}, we
show that arbitrary commands satisfy their strongest specification
with respect to the empty context.*}

lemma SSpec_derivable_empty:"{} \<rhd> c : SSpec c"
(*<*)
apply (rule Cut)
apply (rule Mutrec) apply (subgoal_tac "finite StrongG", assumption)
  apply (simp add: StrongG_def)
  apply (simp add: StrongG_def)
  apply (rule StrongG_verified)
  apply (simp add: StrongG_def)
  apply (rule SSpec_derivable) apply (rule VDMAx) apply simp
done
(*>*)

text{*From this, we easily obtain (relative) completeness.*}

theorem VDM_Complete: "\<Turnstile> c : A \<Longrightarrow> {} \<rhd> c : A"
(*<*)
apply (rule VDMConseq)
apply (rule SSpec_derivable_empty)
apply (erule SSpec_strong)
done
(*>*)

text{*Finally, it is easy to show that valid contexts are verified.*}

lemma Ctxt_valid_verified: "\<Turnstile> G \<Longrightarrow> verified G"
(*<*)
apply (simp add: Ctxt_valid_def verified_def, clarsimp)
apply (erule_tac x=A in allE, simp)
apply (subgoal_tac "\<Turnstile> body : A")
apply (rotate_tac 1, erule thin_rl, drule VDM_Complete) apply (erule WEAK) apply fast
apply (simp add: VDM_valid_def Sem_def, clarsimp)
apply (erule_tac x=s in allE, erule_tac x=t in allE, erule mp)
apply (rule, erule SemCall)
done
(*>*)
text{*End of theory VDM*}
end


section "Small-Step Semantics of Commands"

theory Small_Step imports Star Big_Step begin

subsection "The transition relation"

inductive
  small_step :: "com * state \<Rightarrow> com * state \<Rightarrow> bool" (infix "\<rightarrow>" 55)
where
Assign:  "(x ::= a, s) \<rightarrow> (SKIP, s(x := aval a s))" |

Seq1:    "(SKIP;;c\<^sub>2,s) \<rightarrow> (c\<^sub>2,s)" |
Seq2:    "(c\<^sub>1,s) \<rightarrow> (c\<^sub>1',s') \<Longrightarrow> (c\<^sub>1;;c\<^sub>2,s) \<rightarrow> (c\<^sub>1';;c\<^sub>2,s')" |

IfTrue:  "bval b s \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2,s) \<rightarrow> (c\<^sub>1,s)" |
IfFalse: "\<not>bval b s \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2,s) \<rightarrow> (c\<^sub>2,s)" |

While:   "(WHILE b DO c,s) \<rightarrow>
            (IF b THEN c;; WHILE b DO c ELSE SKIP,s)"

abbreviation
  small_steps :: "com * state \<Rightarrow> com * state \<Rightarrow> bool" (infix "\<rightarrow>*" 55)
where "x \<rightarrow>* y == star small_step x y"

subsection{* Executability *}
context DerTreeExample begin

thm star.refl[of small_step "(SKIP,_)"]

(* Note: There is no SKIP rule, i.e., (SKIP,s) \<rightarrow> (SKIP,s),
  b/c we use SKIP to indicate terminating state.
  Only SKIP in sequential composition goes away with Seq1 rule.

  Hence, SKIP requires some special treatment in the methods below.
*)

method SmallStepSeq = ((rule Seq1 Seq2)+)? (* Apply Seq2 rules to reach leftmost command.
  If encountering SKIP;;_, discharge with Seq1 *)
method SmallStepDerive = SmallStepSeq; (
      rule Assign While
    | (rule IfTrue, (simp;fail))
    | (rule IfFalse, (simp; fail))
    )

method SmallStep = simp?; (rule star.refl[of small_step "(SKIP,_)"]
            | rule star.step, SmallStepDerive)

method SmallSteps = SmallStep+

schematic_goal [simplified]: "(square,<''x'':=2>) \<rightarrow>* ?s"
  apply (rule star.step)
  apply (rule Seq2)
  apply (rule Seq2)
   apply (rule Assign)

  apply (rule star.step)
  apply (rule Seq2)
   apply (rule Seq1)

  apply (rule star.step)
  apply (rule Seq2)
   apply (rule Assign)

  apply (rule star.step)
  apply (rule Seq1)
    oops

schematic_goal "(square,<''x'':=25>) \<rightarrow>* ?s"
  apply SmallSteps
  done

schematic_goal [simplified]: "(square,<''x'':=5>) \<rightarrow>* ?s"
  by (SmallSteps)

end

subsection{* Proof infrastructure *}

subsubsection{* Induction rules *}

text{* The default induction rule @{thm[source] small_step.induct} only works
for lemmas of the form @{text"a \<rightarrow> b \<Longrightarrow> \<dots>"} where @{text a} and @{text b} are
not already pairs @{text"(DUMMY,DUMMY)"}. We can generate a suitable variant
of @{thm[source] small_step.induct} for pairs by ``splitting'' the arguments
@{text"\<rightarrow>"} into pairs: *}
lemmas small_step_induct = small_step.induct[split_format(complete)]

subsubsection{* Proof automation *}

declare small_step.intros[simp,intro]

text{* Rule inversion: *}

inductive_cases SkipE[elim!]: "(SKIP,s) \<rightarrow> ct"
thm SkipE
inductive_cases AssignE[elim!]: "(x::=a,s) \<rightarrow> ct"
thm AssignE
inductive_cases SeqE[elim]: "(c1;;c2,s) \<rightarrow> ct"
thm SeqE
inductive_cases IfE[elim!]: "(IF b THEN c1 ELSE c2,s) \<rightarrow> ct"
inductive_cases WhileE[elim]: "(WHILE b DO c, s) \<rightarrow> ct"

text{* A simple property: *}
lemma deterministic:
  "cs \<rightarrow> cs' \<Longrightarrow> cs \<rightarrow> cs'' \<Longrightarrow> cs'' = cs'"
apply(induction arbitrary: cs'' rule: small_step.induct)
apply blast+
done

subsection "Equivalence with big-step semantics"

lemma star_seq2: "(c1,s) \<rightarrow>* (c1',s') \<Longrightarrow> (c1;;c2,s) \<rightarrow>* (c1';;c2,s')"
proof(induction rule: star_induct)
  case refl thus ?case by simp
next
  case step
  thus ?case by (metis Seq2 star.step)
qed

lemma seq_comp:
  "\<lbrakk> (c1,s1) \<rightarrow>* (SKIP,s2); (c2,s2) \<rightarrow>* (SKIP,s3) \<rbrakk>
   \<Longrightarrow> (c1;;c2, s1) \<rightarrow>* (SKIP,s3)"
by(blast intro: star.step star_seq2 star_trans)

text{* The following proof corresponds to one on the board where one would
show chains of @{text "\<rightarrow>"} and @{text "\<rightarrow>*"} steps. *}

lemma big_to_small:
  "cs \<Rightarrow> t \<Longrightarrow> cs \<rightarrow>* (SKIP,t)"
proof (induction rule: big_step.induct)
  fix s show "(SKIP,s) \<rightarrow>* (SKIP,s)" by simp
next
  fix x a s show "(x ::= a,s) \<rightarrow>* (SKIP, s(x := aval a s))" by auto
next
  fix c1 c2 s1 s2 s3
  assume "(c1,s1) \<rightarrow>* (SKIP,s2)" and "(c2,s2) \<rightarrow>* (SKIP,s3)"
  thus "(c1;;c2, s1) \<rightarrow>* (SKIP,s3)" by (rule seq_comp)
next
  fix s::state and b c0 c1 t
  assume "bval b s"
  hence "(IF b THEN c0 ELSE c1,s) \<rightarrow> (c0,s)" by simp
  moreover assume "(c0,s) \<rightarrow>* (SKIP,t)"
  ultimately
  show "(IF b THEN c0 ELSE c1,s) \<rightarrow>* (SKIP,t)" by (metis star.simps)
next
  fix s::state and b c0 c1 t
  assume "\<not>bval b s"
  hence "(IF b THEN c0 ELSE c1,s) \<rightarrow> (c1,s)" by simp
  moreover assume "(c1,s) \<rightarrow>* (SKIP,t)"
  ultimately
  show "(IF b THEN c0 ELSE c1,s) \<rightarrow>* (SKIP,t)" by (metis star.simps)
next
  fix b c and s::state
  assume b: "\<not>bval b s"
  let ?if = "IF b THEN c;; WHILE b DO c ELSE SKIP"
  have "(WHILE b DO c,s) \<rightarrow> (?if, s)" by blast
  moreover have "(?if,s) \<rightarrow> (SKIP, s)" by (simp add: b)
  ultimately show "(WHILE b DO c,s) \<rightarrow>* (SKIP,s)" by(metis star.refl star.step)
next
  fix b c s s' t
  let ?w  = "WHILE b DO c"
  let ?if = "IF b THEN c;; ?w ELSE SKIP"
  assume w: "(?w,s') \<rightarrow>* (SKIP,t)"
  assume c: "(c,s) \<rightarrow>* (SKIP,s')"
  assume b: "bval b s"
  have "(?w,s) \<rightarrow> (?if, s)" by blast
  moreover have "(?if, s) \<rightarrow> (c;; ?w, s)" by (simp add: b)
  moreover have "(c;; ?w,s) \<rightarrow>* (SKIP,t)" by(rule seq_comp[OF c w])
  ultimately show "(WHILE b DO c,s) \<rightarrow>* (SKIP,t)" by (metis star.simps)
qed

text{* Each case of the induction can be proved automatically: *}
lemma  "cs \<Rightarrow> t \<Longrightarrow> cs \<rightarrow>* (SKIP,t)"
proof (induction rule: big_step.induct)
  case Skip show ?case by blast
next
  case Assign show ?case by blast
next
  case Seq thus ?case by (blast intro: seq_comp)
next
  case IfTrue thus ?case by (blast intro: star.step)
next
  case IfFalse thus ?case by (blast intro: star.step)
next
  case WhileFalse thus ?case
    by (metis star.step star_step1 small_step.IfFalse small_step.While)
next
  case WhileTrue
  thus ?case
    by(metis While seq_comp small_step.IfTrue star.step[of small_step])
qed

lemma "cs \<Rightarrow> t \<Longrightarrow> cs \<rightarrow>* (SKIP,t)"
  by (induction rule: big_step.induct) (blast intro: seq_comp star.step)+

lemma small1_big_continue:
  "cs \<rightarrow> cs' \<Longrightarrow> cs' \<Rightarrow> t \<Longrightarrow> cs \<Rightarrow> t"
apply (induction arbitrary: t rule: small_step.induct)
apply auto
done

lemma small_to_big:
  "cs \<rightarrow>* (SKIP,t) \<Longrightarrow> cs \<Rightarrow> t"
  apply (induction cs "(SKIP,t)" rule: star.induct)
apply (auto intro: small1_big_continue)
done

text {*
  Finally, the equivalence theorem:
*}
theorem big_iff_small:
  "cs \<Rightarrow> t = cs \<rightarrow>* (SKIP,t)"
by(metis big_to_small small_to_big)

subsection "Final configurations and infinite reductions"

definition "final cs \<longleftrightarrow> \<not>(EX cs'. cs \<rightarrow> cs')"

lemma finalD: "final (c,s) \<Longrightarrow> c = SKIP"
apply(simp add: final_def)
apply(induction c)
apply blast+
done

lemma final_iff_SKIP: "final (c,s) = (c = SKIP)"
by (metis SkipE finalD final_def)

text{* Now we can show that @{text"\<Rightarrow>"} yields a final state iff @{text"\<rightarrow>"}
terminates: *}

lemma big_iff_small_termination:
  "(EX t. cs \<Rightarrow> t) \<longleftrightarrow> (EX cs'. cs \<rightarrow>* cs' \<and> final cs')"
by(simp add: big_iff_small final_iff_SKIP)

text{* This is the same as saying that the absence of a big step result is
equivalent with absence of a terminating small step sequence, i.e.\ with
nontermination.  Since @{text"\<rightarrow>"} is determininistic, there is no difference
between may and must terminate. *}

end


(*  Title:      JinjaDCI/J/WWellForm.thy

    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory J/WWellForm.thy by Tobias Nipkow
*)

section \<open> Weak well-formedness of Jinja programs \<close>

theory WWellForm imports "../Common/WellForm" Expr begin

definition wwf_J_mdecl :: "J_prog \<Rightarrow> cname \<Rightarrow> J_mb mdecl \<Rightarrow> bool"
where
  "wwf_J_mdecl P C  \<equiv>  \<lambda>(M,b,Ts,T,(pns,body)).
 length Ts = length pns \<and> distinct pns \<and> \<not>sub_RI body \<and>
  (case b of
   NonStatic \<Rightarrow> this \<notin> set pns \<and> fv body \<subseteq> {this} \<union> set pns
 | Static \<Rightarrow> fv body \<subseteq> set pns)"

lemma wwf_J_mdecl_NonStatic[simp]:
  "wwf_J_mdecl P C (M,NonStatic,Ts,T,pns,body) =
  (length Ts = length pns \<and> distinct pns \<and> \<not>sub_RI body \<and> this \<notin> set pns \<and> fv body \<subseteq> {this} \<union> set pns)"
(*<*)by(simp add:wwf_J_mdecl_def)(*>*)

lemma wwf_J_mdecl_Static[simp]:
  "wwf_J_mdecl P C (M,Static,Ts,T,pns,body) =
  (length Ts = length pns \<and> distinct pns \<and> \<not>sub_RI body \<and> fv body \<subseteq> set pns)"
(*<*)by(simp add:wwf_J_mdecl_def)(*>*)

abbreviation
  wwf_J_prog :: "J_prog \<Rightarrow> bool" where
  "wwf_J_prog \<equiv> wf_prog wwf_J_mdecl"

lemma sees_wwf_nsub_RI:
 "\<lbrakk> wwf_J_prog P; P \<turnstile> C sees M,b : Ts\<rightarrow>T = (pns, body) in D \<rbrakk> \<Longrightarrow> \<not>sub_RI body"
(*<*)by(auto dest!: sees_wf_mdecl simp: wwf_J_mdecl_def wf_mdecl_def)(*>*)

end


theory tp89proof
  imports Main table "~~/src/HOL/Library/Code_Target_Nat" tp89
begin

(* quickcheck [size=7,tester=narrowing,timeout=300]
   nitpick [timeout=300]

  Si on veut du temps supplémentaire avec sledgehammer:
  sledgehammer [provers=e cvc4 spass remote_vampire z3,timeout=300]

  Pour guider l'utilisation de théorèmes particuliers:
  sledgehammer [provers=e cvc4 spass remote_vampire z3,timeout=300] (add: th1 th2 ...)

*)

(*
  Très important!
  ---------------

  Il faut vous assurer en même temps que vous développez votre code et vos preuves
  que le 'export_code' réussi.

  En particulier, à partir du moment où on utilise "~~/src/HOL/Library/Code_Target_Nat" pour
  exporter les nat vers des nat Scala, on perd la possibilité de faire du pattern matching
  sur ces nat. Par exemple une fonction avec des équations de la forme:

  f 0 = ...
  f (Suc x) = ...

 Ne sera plus exportable. Ca ne sert donc à rien de tenter de la prouver, car vous ne pourrez
 pas l'exporter telle quelle.
*)

type_synonym transid= "nat*nat*nat"

type_synonym ligneBdd= "betterNat * betterNat * bool * bool "

(* Le type d'un element de la Bdd: l'identifiant de transaction associée à une ligne de la Bdd *)

type_synonym transBdd= "(transid , ligneBdd) table"

(* Le type des transactions validées *)
type_synonym transaction= "transid * nat"

(* Il est conseillé de séparer le traitement des messages en 3 sous-fonctions:
  traiterPay, traiterAck et traiterCancel *)

(* Lemmes intermédiaires conseillés *)

(* Lemme 1*)
(* Soit m un message d'identifiant tid2. Si tid\<noteq>tid2 alors la valeur associée à tid dans la
   base de donnée ne sera pas modifiée par le traitement du message m.

   Au préalable, il est conseillé de faire des lemmes intermédiaires pour les 3 types de messages à traiter: Pay, Ack, Cancel et
   de les utiliser pour prouver celui-ci *)

lemma modify: "i1 \<noteq> i2 \<longrightarrow> assoc i2 (modify i1 val t) = assoc i2 t "
  apply (induct t)
   apply auto
  done

lemma " (id1 \<noteq> id2) \<longrightarrow> assoc id1 (traiterMessage (Pay id2 m) tt) = assoc id1 tt "
  oops
lemma " (id1 \<noteq> id2) \<longrightarrow> assoc id1 (traiterMessage (Ack id2 m) tt) = assoc id1 tt "
  apply (case_tac "assoc id1 tt")
   prefer 2
   apply (case_tac "assoc id1 (traiterMessage (Ack id2 m) tt)")
    prefer 2
  apply simp

lemma lemme1_3: " (id1 \<noteq> id2) \<longrightarrow> assoc id1 (traiterMessage (Cancel id2) tt) = assoc id1 tt "
  apply auto
  using modify apply metis
  done

(* Lemme 2 *)
(* Quelque soit la bdd quand on traite un message (Cancel tid), on obtient une nouvelle
   bdd dans laquelle tid est associé à un statut annulé, et des prix client et marchand
   indéfinis *)

lemma "assoc id1 (traiterMessage (Cancel id1) tt) = Some((Undeclared, Undeclared, True, False))"
  oops
(* On traite les messages en commencant par la fin de la liste. On voit la liste comme une file.
   Coherent avec ce qui se passe dans l'IHM. Cela simplifie grandement les preuves! *)

fun traiterMessageList:: "message list \<Rightarrow> transBdd"
where
"traiterMessageList [] = []" |
"traiterMessageList (m#r)= (traiterMessage m (traiterMessageList r))"

(* Définir une fonction validOne déterminant si une ligne de la Bdd est valide.
   Une bdd tbdd sera valide si (forAll validOne tbdd) est vraie *)

fun validOne:: "ligneBdd \<Rightarrow> bool" where
  "validOne (amc, amm, ccl, vld) = (if (vld) then True else False) "

fun valide::" transBdd \<Rightarrow> bool" where
  "valide [] = False " |
  "valide [(id1, x)] = validOne x " |
  "valide ((id1,x)#xs) = ((validOne x) \<and> (valide xs)) "

(* Lemme 3 *)
(* Si une bdd est valide, alors quelque soit la ligne obtenue par la fonction assoc, celle-ci est valide *)

lemma " valide tt \<longrightarrow> assoc id1 tt = Some(a) \<longrightarrow>  validOne(a)"
  oops

(* Lemme 4 *)
(* Si une bdd est valide, pour toute ligne associée à un tid, si le statut est Validated,
   cela signifie que le prix marchand est supérieur ou égal au prix client *)

(* Lemme 5 *)
(* Si une bdd est valide, elle restera valide pour toutes les modifications (valides) opérées. *)
(* Par exemple:
  Si une bdd est valide et que l'on modifie la ligne associée à tid par une nouvelle ligne
  correcte alors la nouvelle bdd est valide également.

  Définir et prouver tous les cas possibles de modification dans des lemmes distincts.
*)

(* Lemme 6 *)
(* Si une bdd est valide alors pour toute ligne associée à tid, si le statut est Validated alors p1 et p2 ne peuvent être indéfinis *)

(* Lemme 7 *)
(* Dans une bdd valide alors pour toute ligne associée à tid, avec des prix client et marchand définis, si le prix client est supérieur
   ou égal au prix du marchand alors le statut de la ligne est Validated *)

(* Lemme 8 *)
(* Dans une bdd valide, pour toute ligne associée à tid, si le statut est Partial, alors le prix du client ou du marchand est défini. *)

(* Lemme 9 *)
(* Si une bdd est valide, traiter un message Pay sur cette bdd rendra une bdd valide *)

(* Lemme 10 *)
(* Si une bdd est valide, traiter un message Ack sur cette bdd rendra une bdd valide *)

(* Lemme 11 *)
(* Si une bdd est valide, traiter un message Cancel sur cette bdd rendra une bdd valide *)

(* Lemme 12 *)
(* Si une bdd est valide, traiter tout message sur cette bdd rendra une bdd valide *)

(* Lemme 13 *)
(* traiterMessageList ne construit que des bdds valides *)

(* ---- Prop 1: Toutes les transactions validées ont un montant strictement supérieur à 0. *)

(* Lemme intermédiaire: Lemme 14 *)
(* A partir de toute bdd valide, export contruit une liste de couples (tid,p) tel que
   p est strictement positif *)

(* Définir Prop1 *)

(* ---- Prop2:
   Dans la liste de transactions validées, tout triplet {\tt (c,m,i)} (où
  {\tt c} est un numéro de client, {\tt m} est un numéro de marchand et {\tt i}
  un numéro de transaction) n'apparaît qu'une seule fois.
*)

(* Lemmes intermédiaires *)

(* Lemme 15 *)
(* Si une bdd a des clés uniques, traiter un message Pay rend une bdd avec des clés uniques *)

(* Lemme 16 *)
(* Si une bdd a des clés uniques, traiter un message Ack rend une bdd avec des clés uniques *)

(* Lemme 17 *)
(* Si une bdd a des clés uniques, traiter un message Pay/Ack/Cancel rend une bdd avec des clés uniques *)

(* Lemme 18 *)
(* traiterMessageList rend une bdd avec des clés uniques *)

(* Lemme 19 *)
(* Les transactions ne figurant pas dans la bdd, ne figurent pas dans l'export *)

(* Lemme 20 *)
(* Si les clés sont unique dans une bdd, elles le seront dans l'export *)

(* Définir prop2 *)

(* Prop 3 *)
(* Toute transaction (même validée) peut être annulée. *)
(* Prop 4*)
(* Toute transaction annulée l'est définitivement: un message {\tt (Cancel
    (c,m,i))} rend impossible  la validation d'une transaction de numéro {\tt
    i} entre un marchand {\tt m} et un client {\tt c}.*)

(* On fait les deux en une seule propriété *)

(* Lemme 21 *)
(* Dans une bdd si le statut d'une transaction est Cancelled, celui-ci reste Cancelled quelque soit le message traité *)

(* Lemme 22 *)
(* Si un message (Cancel tid) apparaît dans une liste de message et que l'on construit
   une bdd par traitement de toute cette liste de message, alors dans cette bdd, la ligne
   associée à la transation tid aura un statut Cancelled et les prix seront indéfinis *)

(* Lemme 23 *)
(* Dans une bdd si une transaction est annulée, celle-ci n'apparaîtra pas dans l'export *)

(* Définir prop 3 et 4 *)

(* Prop 5:
Si un message {\tt Pay} et un message {\tt Ack}, tels que le montant
  proposé par le {\tt Pay} est strictement supérieur à 0, supérieur ou égal au
  montant proposé par le message {\tt Ack} et non annulée, ont été envoyés alors la transaction figure
  dans la liste des transactions validées.
*)

(* Lemme 24 *)
(* Si les clés sont uniques dans une bdd, une transition aura le statut Validated si et seulement si
   elle figure dans l'export *)

(* Lemme 25 *)
(* Si le message (Cancel tid) n'apparaît PAS dans une liste de message et que l'on construit
   une bdd par traitement de toute cette liste de message, la ligne
   associée à la transation tid dans la bdd ne pourra avoir le statut Cancelled *)

(* Lemme 26 *)
(* Si une liste de message lmess contient un message de la forme (Pay tid mc) et ne contient pas de (Cancel tid) alors
   alors il existe une ligne associée à tid dans la bdd obtenue par traitement de lmess et le prix client est défini. *)

(* Lemme 27 *)
(* Si une liste de message lmess contient un message de la forme (Ack tid mc) et ne contient pas de (Cancel tid) alors
   alors il existe une ligne associée à tid dans la bdd obtenue par traitement de lmess et le prix marchand est défini. *)

(* Lemme 28 *)
lemma PricePayMessage: "(mc > 0 \<and>
  (forAll validOne tbdd) \<and> ((assoc tid tbdd) = (Some (p3,p4,s2))) \<and> s2\<noteq>Validated
    \<and> ((assoc tid (traiterMessage (Pay tid mc) tbdd)) = (Some ((Mynat p1),p2,s))))
      \<longrightarrow> p1\<ge>mc"
sorry

(* Lemme 29 *)
lemma PricePayMessage2: "(mc > 0 \<and>
  (forAll validOne tbdd) \<and> ((assoc tid (traiterMessage (Pay tid mc) tbdd)) = (Some ((Mynat p1),p2,s)))
  \<and> s\<noteq>Validated) \<longrightarrow> p1\<ge>mc"
sorry

(* Lemme 30 *)
(* Un message Ack ne peut changer le prix client dans une base valide *)

(* Lemme 31 *)
(* Un message Pay ne peut changer le prix marchand dans une base valide*)

(* Lemme 31 bis *)
(* Soit une tbdd valide, si dans cette base le prix client est mc pour un tid donné, alors
   Traiter un message Pay sur le même tid avec un prix inférieur ou égal à mc, ne change
   pas la base de données *)

(* Lemme 32 *)
(* Soit une bdd obtenue par traitement d'une liste de message contenant un message (Pay tid mc)
   Si cette bdd contient une ligne pour tid, que le prix client est défini et vaut p1, alors p1 est supérieur
   ou égal à mc.
 *)

(* Lemme 33 *)
lemma PriceAckMessage: "((forAll validOne tbdd) \<and> ((assoc tid tbdd) = (Some (p3,p4,s2))) \<and> s2\<noteq>Validated
    \<and> ((assoc tid (traiterMessage (Ack tid mm) tbdd)) = (Some (p1,(Mynat p2),s))))
      \<longrightarrow> p2\<le>mm"
sorry

(* Lemme 34 *)
lemma PriceAckMessage2: "((forAll validOne tbdd) \<and> ((assoc tid (traiterMessage (Ack tid mm) tbdd)) = (Some (p1,(Mynat p2),s))) \<and> s\<noteq>Validated)
  \<longrightarrow> p2\<le>mm"
sorry

(* Lemme 35 *)
(* Soit une bdd obtenue par traitement d'une liste de message contenant un message (Ack tid mm)
   Si cette bdd contient une ligne pour tid, que le prix marchand est défini et vaut p2, alors p2 est inférieur
   ou égal à mm.
 *)

(* Lemme 36 *)
(* Si une liste de message lmess contient un (Pay tid mc) et (Ack tid mm) avec mc supérieur ou égal
   à mm (et mc supérieur à 0) et pas de (Cancel tid) alors il existe une ligne associée
   à tid dans la bdd générée en traitant lmess. Dans cette ligne le statut est Validated et les prix
   client et marchand sont définis. *)

(* Définir Prop5 *)

(* Prop 6:
Toute transaction figurant dans la liste des transactions validées l'a été
  par un message {\tt Pay} et un message {\tt Ack} tels que le montant proposé
  par le {\tt Pay} est supérieur ou égal au montant proposé par le message {\tt
    Ack}.  *)

(* Lemme 37 *)
(*Soit une bdd produite par traitement d'une liste de messages lmess.
  Dans la bdd tout prix client mc associé à tid, vient d'un message (Pay tid mc) figurant dans lmess *)

(* Lemme 38 *)
(*Soit une bdd produite par traitement d'une liste de messages lmess.
  Dans la bdd tout prix marchand mm associé à tid, vient d'un message (Ack tid mm) figurant dans lmess *)

(* Lemme 39 *)
(* Si une transaction figure dans le export alors elle a une ligne dans la bdd avec un statut Validated *)

(* Définir Prop6 *)

(* Prop 7 *)
(*
  Si un client (resp. marchand) a proposé un montant {\tt am} pour une
  transaction, tout montant {\tt am'} inférieur (resp. supérieur) proposé par la
  suite est ignoré par l'agent de validation.
*)

(* Lemme 40 *)
(* Dans une bdd si une transaction est validée, elle le reste quelque soit le message de type Pay que l'on traite et ses
   valeurs de prix marchand et client sont conservées. *)

(* Lemme 41 *)
(* Dans une bdd si une transaction est validée, elle le reste quelque soit le message de type Ack que l'on traite et ses
   valeurs de prix marchand et client sont conservées. *)

(* Prop7 pour un message client *)
(* Soit tbdd une bdd obtenue après traitement d'une liste de messages lmess et mc1 et mc2 deux prix tels que mc1>0 et mc2>mc1.
   Soit lmess une liste de messages contenant (Pay tid mc2) et ne contenant pas (Pay tid mc1). Si l'on traite (Pay tid mc1)
   sur tbdd, ça ne changera pas la ligne associée à tid dans la bdd *)

(* Prop7 pour un message marchand *)
(* Soit tbdd une bdd obtenue après traitement d'une liste de messages lmess et mm1 et mm2 deux prix tels que mm2<mm1.
   Soit lmess une liste de messages contenant (Pay tid mm2) et ne contenant pas (Pay tid mm1). Si l'on traite (Pay tid mm1)
   sur tbdd, ça ne changera pas la ligne associée à tid dans la bdd *)

(* Prop 8 *)

(* Toute transaction validée ne peut être renégociée: si une transaction a
  été validée avec un montant {\tt am} celui-ci ne peut être changé.
*)

(* Lemme 42 *)
(* Dans une bdd si la ligne associée à un tid a un statut Validated, quelque soit le message (différent de Cancel) traité
   sur la bdd, les prix et le statut de la ligne ne change pas. *)

(* Définir Prop8 *)

(* Prop9: Le montant associé à une transaction validée correspond à un prix proposé
  par le client pour cette transaction. *)

(* Pas de lemmes intermédiaires *)

end