theory Laplace_Transform_Library
  imports
    "HOL-Analysis.Analysis"
begin

section \<open>References\<close>

text \<open>
Much of this formalization is based on Schiff's textbook \<^cite>\<open>"Schiff2013"\<close>.
Parts of this formalization are inspired by the HOL-Light formalization
(\<^cite>\<open>"Taqdees2013"\<close>, \<^cite>\<open>"Rashid2017"\<close>, \<^cite>\<open>"Rashid2018"\<close>), but stated more generally for
piecewise continuous (instead of piecewise continuously differentiable) functions.
\<close>

section \<open>Library Additions\<close>

subsection \<open>Derivatives\<close>

lemma DERIV_compose_FDERIV:\<comment>\<open>TODO: generalize and move from HOL-ODE\<close>
  assumes "DERIV f (g x) :> f'"
  assumes "(g has_derivative g') (at x within s)"
  shows "((\<lambda>x. f (g x)) has_derivative (\<lambda>x. g' x * f')) (at x within s)"
  using assms has_derivative_compose[of g g' x s f "(*) f'"]
  by (auto simp: has_field_derivative_def ac_simps)

lemmas has_derivative_sin[derivative_intros] = DERIV_sin[THEN DERIV_compose_FDERIV]
  and  has_derivative_cos[derivative_intros] = DERIV_cos[THEN DERIV_compose_FDERIV]
  and  has_derivative_exp[derivative_intros] = DERIV_exp[THEN DERIV_compose_FDERIV]

subsection \<open>Integrals\<close>

lemma negligible_real_ivlI:
  fixes a b::real
  assumes "a \<ge> b"
  shows "negligible {a .. b}"
proof -
  from assms have "{a .. b} = {a} \<or> {a .. b} = {}"
    by auto
  then show ?thesis
    by auto
qed

lemma absolutely_integrable_on_combine:
  fixes f :: "real \<Rightarrow> 'a::euclidean_space"
  assumes "f absolutely_integrable_on {a..c}"
    and "f absolutely_integrable_on {c..b}"
    and "a \<le> c"
    and "c \<le> b"
  shows "f absolutely_integrable_on {a..b}"
  using assms
  unfolding absolutely_integrable_on_def integrable_on_def
  by (auto intro!: has_integral_combine)

lemma dominated_convergence_at_top:
  fixes f :: "real \<Rightarrow> 'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
  assumes f: "\<And>k. (f k) integrable_on s" and h: "h integrable_on s"
    and le: "\<And>k x. x \<in> s \<Longrightarrow> norm (f k x) \<le> h x"
    and conv: "\<forall>x \<in> s. ((\<lambda>k. f k x) \<longlongrightarrow> g x) at_top"
  shows "g integrable_on s" "((\<lambda>k. integral s (f k)) \<longlongrightarrow> integral s g) at_top"
proof -
  have 3: "set_integrable lebesgue s h"
    unfolding absolutely_integrable_on_def
  proof
    show "(\<lambda>x. norm (h x)) integrable_on s"
    proof (intro integrable_spike_finite[OF _ _ h, where S="{}"] ballI)
      fix x assume "x \<in> s - {}" then show "norm (h x) = h x"
        using order_trans[OF norm_ge_zero le[of x]] by auto
    qed auto
  qed fact
  have 2: "set_borel_measurable lebesgue s (f k)" for k
    using f[of k]
    using has_integral_implies_lebesgue_measurable[of "f k"]
    by (auto intro:  simp: integrable_on_def set_borel_measurable_def)
  have conv': "\<forall>x \<in> s. ((\<lambda>k. f k x) \<longlongrightarrow> g x) sequentially"
    using conv filterlim_filtermap filterlim_compose filterlim_real_sequentially by blast
  from 2 have 1: "set_borel_measurable lebesgue s g"
    unfolding set_borel_measurable_def
    by (rule borel_measurable_LIMSEQ_metric) (use conv' in \<open>auto split: split_indicator\<close>)
  have 4: "AE x in lebesgue. ((\<lambda>i. indicator s x *\<^sub>R f i x) \<longlongrightarrow> indicator s x *\<^sub>R g x) at_top"
    "\<forall>\<^sub>F i in at_top. AE x in lebesgue. norm (indicator s x *\<^sub>R f i x) \<le> indicator s x *\<^sub>R h x"
    using conv le by (auto intro!: always_eventually split: split_indicator)

  note 1 2 3 4
  note * = this[unfolded set_borel_measurable_def set_integrable_def]
  have g: "g absolutely_integrable_on s"
    unfolding set_integrable_def
    by (rule integrable_dominated_convergence_at_top[OF *])
  then show "g integrable_on s"
    by (auto simp: absolutely_integrable_on_def)
  have "((\<lambda>k. (LINT x:s|lebesgue. f k x)) \<longlongrightarrow> (LINT x:s|lebesgue. g x)) at_top"
    unfolding set_lebesgue_integral_def
    using *
    by (rule integral_dominated_convergence_at_top)
  then show "((\<lambda>k. integral s (f k)) \<longlongrightarrow> integral s g) at_top"
    using g absolutely_integrable_integrable_bound[OF le f h]
    by (subst (asm) (1 2) set_lebesgue_integral_eq_integral) auto
qed

lemma has_integral_dominated_convergence_at_top:
  fixes f :: "real \<Rightarrow> 'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
  assumes "\<And>k. (f k has_integral y k) s" "h integrable_on s"
    "\<And>k x. x\<in>s \<Longrightarrow> norm (f k x) \<le> h x" "\<forall>x\<in>s. ((\<lambda>k. f k x) \<longlongrightarrow> g x) at_top"
    and x: "(y \<longlongrightarrow> x) at_top"
  shows "(g has_integral x) s"
proof -
  have int_f: "\<And>k. (f k) integrable_on s"
    using assms by (auto simp: integrable_on_def)
  have "(g has_integral (integral s g)) s"
    by (intro integrable_integral dominated_convergence_at_top[OF int_f assms(2)]) fact+
  moreover have "integral s g = x"
  proof (rule tendsto_unique)
    show "((\<lambda>i. integral s (f i)) \<longlongrightarrow> x) at_top"
      using integral_unique[OF assms(1)] x by simp
    show "((\<lambda>i. integral s (f i)) \<longlongrightarrow> integral s g) at_top"
      by (intro dominated_convergence_at_top[OF int_f assms(2)]) fact+
  qed simp
  ultimately show ?thesis
    by simp
qed

lemma integral_indicator_eq_restriction:
  fixes f::"'a::euclidean_space \<Rightarrow> 'b::banach"
  assumes f: "f integrable_on R"
    and "R \<subseteq> S"
  shows "integral S (\<lambda>x. indicator R x *\<^sub>R f x) = integral R f"
proof -
  let ?f = "\<lambda>x. indicator R x *\<^sub>R f x"
  have "?f integrable_on R"
    using f negligible_empty
    by (rule integrable_spike) auto
  from integrable_integral[OF this]
  have "(?f has_integral integral R ?f) S"
    by (rule has_integral_on_superset) (use \<open>R \<subseteq> S\<close> in \<open>auto simp: indicator_def\<close>)
  also have "integral R ?f = integral R f"
    using negligible_empty
    by (rule integral_spike) auto
  finally show ?thesis
    by blast
qed

lemma
  improper_integral_at_top:
  fixes f::"real \<Rightarrow> 'a::euclidean_space"
  assumes "f absolutely_integrable_on {a..}"
  shows "((\<lambda>x. integral {a..x} f) \<longlongrightarrow> integral {a..} f) at_top"
proof -
  let ?f = "\<lambda>(k::real) (t::real). indicator {a..k} t *\<^sub>R f t"
  have f: "f integrable_on {a..k}" for k
    using set_lebesgue_integral_eq_integral(1)[OF assms]
    by (rule integrable_on_subinterval) simp
  from this negligible_empty have "?f k integrable_on {a..k}" for k
    by (rule integrable_spike) auto
  from this have "?f k integrable_on {a..}" for k
    by (rule integrable_on_superset) auto
  moreover
  have "(\<lambda>x. norm (f x)) integrable_on {a..}"
    using assms by (simp add: absolutely_integrable_on_def)
  moreover
  note _
  moreover
  have "\<forall>\<^sub>F k in at_top. k \<ge> x" for x::real
    by (simp add: eventually_ge_at_top)
  then have "\<forall>x\<in>{a..}. ((\<lambda>k. ?f k x) \<longlongrightarrow> f x) at_top"
    by (auto intro!: Lim_transform_eventually[OF tendsto_const] simp: indicator_def eventually_at_top_linorder)
  ultimately
  have "((\<lambda>k. integral {a..} (?f k)) \<longlongrightarrow> integral {a ..} f) at_top"
    by (rule dominated_convergence_at_top) (auto simp: indicator_def)
  also have "(\<lambda>k. integral {a..} (?f k)) = (\<lambda>k. integral {a..k} f)"
    by (auto intro!: ext integral_indicator_eq_restriction f)
  finally show ?thesis .
qed

lemma norm_integrable_onI: "(\<lambda>x. norm (f x)) integrable_on S"
  if "f absolutely_integrable_on S"
  for f::"'a::euclidean_space\<Rightarrow>'b::euclidean_space"
  using that by (auto simp: absolutely_integrable_on_def)

lemma
  has_integral_improper_at_topI:
  fixes f::"real \<Rightarrow> 'a::banach"
  assumes I: "\<forall>\<^sub>F k in at_top. (f has_integral I k) {a..k}"
  assumes J: "(I \<longlongrightarrow> J) at_top"
  shows "(f has_integral J) {a..}"
  apply (subst has_integral')
proof (auto, goal_cases)
  case (1 e)
  from tendstoD[OF J \<open>0 < e\<close>]
  have "\<forall>\<^sub>F x in at_top. dist (I x) J < e" .
  moreover have "\<forall>\<^sub>F x in at_top. (x::real) > 0" by simp
  moreover have "\<forall>\<^sub>F x in at_top. (x::real) > - a"\<comment>\<open>TODO: this seems to be strange?\<close>
    by simp
  moreover note I
  ultimately have "\<forall>\<^sub>F x in at_top. x > 0 \<and> x > - a \<and> dist (I x) J < e \<and>
    (f has_integral I x) {a..x}" by eventually_elim auto
  then obtain k where k: "\<forall>b\<ge>k. norm (I b - J) < e" "k > 0" "k > - a"
    and I: "\<And>c. c \<ge> k \<Longrightarrow> (f has_integral I c) {a..c}"
    by (auto simp: eventually_at_top_linorder dist_norm)
  show ?case
    apply (rule exI[where x=k])
    apply (auto simp: \<open>0 < k\<close>)
    subgoal premises prems for b c
    proof -
      have ball_eq: "ball 0 k = {-k <..< k}" by (auto simp: abs_real_def split: if_splits)
      from prems \<open>0 < k\<close> have "c \<ge> 0" "b \<le> 0"
        by (auto simp: subset_iff)
      with prems \<open>0 < k\<close> have "c \<ge> k"
        apply (auto simp: ball_eq)
        apply (auto simp: subset_iff)
        apply (drule spec[where x="(c + k)/2"])
        apply (auto simp: algebra_split_simps not_less)
        using \<open>0 \<le> c\<close> by linarith
      then have "norm (I c - J) < e" using k by auto
      moreover
      from prems \<open>0 < k\<close> \<open>c \<ge> 0\<close> \<open>b \<le> 0\<close> \<open>c \<ge> k\<close> \<open>k > - a\<close> have "a \<ge> b"
        apply (auto simp: ball_eq)
        apply (auto simp: subset_iff)
        by (meson \<open>b \<le> 0\<close> less_eq_real_def minus_less_iff not_le order_trans)
      have "((\<lambda>x. if x \<in> cbox a c then f x else 0) has_integral I c) (cbox b c)"
        apply (subst has_integral_restrict_closed_subintervals_eq)
        using I[of c] prems \<open>a \<ge> b\<close> \<open>k \<le> c\<close>
        by (auto )
      from negligible_empty _ this have "((\<lambda>x. if a \<le> x then f x else 0) has_integral I c) (cbox b c)"
        by (rule has_integral_spike) auto
      ultimately
      show ?thesis
        by (intro exI[where x="I c"]) auto
    qed
    done
qed

subsection \<open>Miscellaneous\<close>

lemma AE_BallI: "AE x\<in>X in F. P x" if "\<forall>x \<in> X. P x"
  using that by (intro always_eventually) auto

lemma bounded_le_Sup:
  assumes "bounded (f ` S)"
  shows "\<forall>x\<in>S. norm (f x) \<le> Sup (norm ` f ` S)"
  by (auto intro!: cSup_upper bounded_imp_bdd_above simp: bounded_norm_comp assms)

end


(*  Title:      HOL/Lex/NA.thy
    ID:         $Id: NA.thy,v 1.1.1.1 2000/07/26 13:34:11 bu Exp $
    Author:     Tobias Nipkow
    Copyright   1998 TUM

Some basic definitions on automata.
*)

theory Automata
imports  Main
begin

section{* The Type of Non-Deterministic Automata *}

find_theorems name:"na" name:"Automata"

record ('a,'s)na =
   start :: "'s"
   "next":: "'a \<Rightarrow> 's \<Rightarrow> 's set"
   fin   :: "('s \<Rightarrow> bool)"

find_theorems name:"na" name:"Automata" (* just to check the global effect of the record *)

(*create a set who have all the element of 'a list*)
text{* set of states reachable after a word  @{term "w"} from the initial state.*}
primrec delta :: "('a,'s)na \<Rightarrow> 'a list \<Rightarrow> 's \<Rightarrow> 's set"
where  "delta A []    p = {p}"                       (*return the set {p}*)
      |"delta A (a#w) p = \<Union>(delta A w ` next A a p)"(*next A a p return a*)

definition accepts ::   "('a,'s)na \<Rightarrow> 'a list \<Rightarrow> bool"
where     "accepts A w == \<exists> q \<in> delta A w (start A). fin A q"

definition step :: "('a,'s)na \<Rightarrow> 'a \<Rightarrow> ('s * 's)set"
where     "step A a == {(p,q) . q : next A a p}"

primrec steps :: "('a,'s)na \<Rightarrow> 'a list \<Rightarrow> ('s * 's)set"
where
 "steps A [] = Id"
|"steps A (a#w) =  step A a  O  steps A w "

lemma steps_append[simp] : "steps A (v @ w) =  steps A v O steps A w "
apply (induct "v" )
apply (simp_all add: O_assoc)
done

lemma in_steps_append [intro] :  "((p, r) \<in> steps A (v @ w)) = ((p, r) \<in> steps A v  O  steps A w)"
by(rule steps_append[THEN equalityE]) blast

lemma delta_conv_steps :  " \<forall>p. delta A w p = {q. (p, q) \<in> steps A w}"
  apply(induct w)
   apply(auto)
  using step_def apply fastforce
  using step_def by fastforce

lemma accepts_conv_steps : "accepts A w = (\<exists>q. (start A, q) \<in> steps A w \<and> fin A q)"
  by (simp add: accepts_def delta_conv_steps)

section{* Deterministic Automaton *}

record ('a,'s)da =
   start :: "'s"
   "next":: "'a \<Rightarrow> 's \<Rightarrow> 's"
   fin   :: "('s \<Rightarrow> bool)"

definition   foldl2 :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b \<Rightarrow> 'b"
where       "foldl2 f xs a == foldl (\<lambda>a b. f b a) a xs"

definition   delta\<^sub>d\<^sub>a :: "('a,'s)da \<Rightarrow> 'a list \<Rightarrow> 's \<Rightarrow> 's"
where       "delta\<^sub>d\<^sub>a A == foldl2 (da.next  A)"

definition   accepts\<^sub>d\<^sub>a ::  "('a,'s)da \<Rightarrow> 'a list \<Rightarrow> bool"
where       "accepts\<^sub>d\<^sub>a A == \<lambda>w. fin A (delta\<^sub>d\<^sub>a A w (start A))"

end


(*
    Authors:      Jose Divasón
                  Sebastiaan Joosten
                  René Thiemann
                  Akihisa Yamada
*)
subsection \<open>Finite Fields\<close>

text \<open>We provide four implementations for $GF(p)$ -- the field with $p$ elements for some
  prime $p$ -- one by int, one by integers, one by 32-bit numbers and one 64-bit implementation.
  Correctness of the implementations is proven by
  transfer rules to the type-based version of $GF(p)$.\<close>

theory Finite_Field_Record_Based
imports
  Finite_Field
  Arithmetic_Record_Based
  Native_Word.Uint32
  Native_Word.Uint64
  "HOL-Library.Code_Target_Numeral"
  Native_Word.Code_Target_Int_Bit
begin

(* mod on standard case which can immediately be mapped to
   target languages without considering special cases *)
definition mod_nonneg_pos :: "integer \<Rightarrow> integer \<Rightarrow> integer" where
  "x \<ge> 0 \<Longrightarrow> y > 0 \<Longrightarrow> mod_nonneg_pos x y = (x mod y)"

code_printing \<comment> \<open>FIXME illusion of partiality\<close>
  constant mod_nonneg_pos \<rightharpoonup>
        (SML) "IntInf.mod/ ( _,/ _ )"
    and (Eval) "IntInf.mod/ ( _,/ _ )"
    and (OCaml) "Z.rem"
    and (Haskell) "Prelude.mod/ ( _ )/ ( _ )"
    and (Scala) "!((k: BigInt) => (l: BigInt) =>/ (k '% l))"

definition mod_nonneg_pos_int :: "int \<Rightarrow> int \<Rightarrow> int" where
  "mod_nonneg_pos_int x y = int_of_integer (mod_nonneg_pos (integer_of_int x) (integer_of_int y))"

lemma mod_nonneg_pos_int[simp]: "x \<ge> 0 \<Longrightarrow> y > 0 \<Longrightarrow> mod_nonneg_pos_int x y = (x mod y)"
  unfolding mod_nonneg_pos_int_def using mod_nonneg_pos_def by simp

context
  fixes p :: int
begin
definition plus_p :: "int \<Rightarrow> int \<Rightarrow> int" where
  "plus_p x y \<equiv> let z = x + y in if z \<ge> p then z - p else z"

definition minus_p :: "int \<Rightarrow> int \<Rightarrow> int" where
  "minus_p x y \<equiv> if y \<le> x then x - y else x + p - y"

definition uminus_p :: "int \<Rightarrow> int" where
  "uminus_p x = (if x = 0 then 0 else p - x)"

definition mult_p :: "int \<Rightarrow> int \<Rightarrow> int" where
  "mult_p x y = (mod_nonneg_pos_int (x * y) p)"

fun power_p :: "int \<Rightarrow> nat \<Rightarrow> int" where
  "power_p x n = (if n = 0 then 1 else
    let (d,r) = Euclidean_Rings.divmod_nat n 2;
       rec = power_p (mult_p x x) d in
    if r = 0 then rec else mult_p rec x)"

text \<open>In experiments with Berlekamp-factorization (where the prime $p$ is usually small),
  it turned out that taking the below implementation of inverse via exponentiation
  is faster than the one based on the extended Euclidean algorithm.\<close>

definition inverse_p :: "int \<Rightarrow> int" where
  "inverse_p x = (if x = 0 then 0 else power_p x (nat (p - 2)))"

definition divide_p :: "int \<Rightarrow> int \<Rightarrow> int"  where
  "divide_p x y = mult_p x (inverse_p y)"

definition finite_field_ops_int :: "int arith_ops_record" where
  "finite_field_ops_int \<equiv> Arith_Ops_Record
      0
      1
      plus_p
      mult_p
      minus_p
      uminus_p
      divide_p
      inverse_p
      (\<lambda> x y . if y = 0 then x else 0)
      (\<lambda> x . if x = 0 then 0 else 1)
      (\<lambda> x . x)
      (\<lambda> x . x)
      (\<lambda> x . x)
      (\<lambda> x. 0 \<le> x \<and> x < p)"

end

context
  fixes p :: uint32
begin
definition plus_p32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" where
  "plus_p32 x y \<equiv> let z = x + y in if z \<ge> p then z - p else z"

definition minus_p32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" where
  "minus_p32 x y \<equiv> if y \<le> x then x - y else (x + p) - y"

definition uminus_p32 :: "uint32 \<Rightarrow> uint32" where
  "uminus_p32 x = (if x = 0 then 0 else p - x)"

definition mult_p32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" where
  "mult_p32 x y = (x * y mod p)"

lemma int_of_uint32_shift: "int_of_uint32 (drop_bit k n) = (int_of_uint32 n) div (2 ^ k)"
  apply transfer
  apply transfer
  apply (simp add: take_bit_drop_bit min_def)
  apply (simp add: drop_bit_eq_div)
  done

lemma int_of_uint32_0_iff: "int_of_uint32 n = 0 \<longleftrightarrow> n = 0"
  by (transfer, rule uint_0_iff)

lemma int_of_uint32_0: "int_of_uint32 0 = 0" unfolding int_of_uint32_0_iff by simp

lemma int_of_uint32_ge_0: "int_of_uint32 n \<ge> 0"
  by (transfer, auto)

lemma two_32: "2 ^ LENGTH(32) = (4294967296 :: int)" by simp

lemma int_of_uint32_plus: "int_of_uint32 (x + y) = (int_of_uint32 x + int_of_uint32 y) mod 4294967296"
  by (transfer, unfold uint_word_ariths two_32, rule refl)

lemma int_of_uint32_mult: "int_of_uint32 (x * y) = (int_of_uint32 x * int_of_uint32 y) mod 4294967296"
  by (transfer, unfold uint_word_ariths two_32, rule refl)

lemma int_of_uint32_mod: "int_of_uint32 (x mod y) = (int_of_uint32 x mod int_of_uint32 y)"
  by (transfer, unfold uint_mod two_32, rule refl)

lemma int_of_uint32_inv: "0 \<le> x \<Longrightarrow> x < 4294967296 \<Longrightarrow> int_of_uint32 (uint32_of_int x) = x"
  by transfer (simp add: take_bit_int_eq_self unsigned_of_int)

context
  includes bit_operations_syntax
begin

function power_p32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" where
  "power_p32 x n = (if n = 0 then 1 else
    let rec = power_p32 (mult_p32 x x) (drop_bit 1 n) in
    if n AND 1 = 0 then rec else mult_p32 rec x)"
  by pat_completeness auto

termination
proof -
  {
    fix n :: uint32
    assume "n \<noteq> 0"
    with int_of_uint32_ge_0[of n] int_of_uint32_0_iff[of n] have "int_of_uint32 n > 0" by auto
    hence "0 < int_of_uint32 n" "int_of_uint32 n div 2 < int_of_uint32 n" by auto
  } note * = this
  show ?thesis
    by (relation "measure (\<lambda> (x,n). nat (int_of_uint32 n))", auto simp: int_of_uint32_shift *)
qed

end

text \<open>In experiments with Berlekamp-factorization (where the prime $p$ is usually small),
  it turned out that taking the below implementation of inverse via exponentiation
  is faster than the one based on the extended Euclidean algorithm.\<close>

definition inverse_p32 :: "uint32 \<Rightarrow> uint32" where
  "inverse_p32 x = (if x = 0 then 0 else power_p32 x (p - 2))"

definition divide_p32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32"  where
  "divide_p32 x y = mult_p32 x (inverse_p32 y)"

definition finite_field_ops32 :: "uint32 arith_ops_record" where
  "finite_field_ops32 \<equiv> Arith_Ops_Record
      0
      1
      plus_p32
      mult_p32
      minus_p32
      uminus_p32
      divide_p32
      inverse_p32
      (\<lambda> x y . if y = 0 then x else 0)
      (\<lambda> x . if x = 0 then 0 else 1)
      (\<lambda> x . x)
      uint32_of_int
      int_of_uint32
      (\<lambda> x. 0 \<le> x \<and> x < p)"
end

lemma shiftr_uint32_code [code_unfold]: "drop_bit 1 x = (uint32_shiftr x 1)"
  by (simp add: uint32_shiftr_def)

(* ******************************************************************************** *)
subsubsection \<open>Transfer Relation\<close>
locale mod_ring_locale =
  fixes p :: int and ty :: "'a :: nontriv itself"
  assumes p: "p = int CARD('a)"
begin
lemma nat_p: "nat p = CARD('a)" unfolding p by simp
lemma p2: "p \<ge> 2" unfolding p using nontriv[where 'a = 'a] by auto
lemma p2_ident: "int (CARD('a) - 2) = p - 2" using p2 unfolding p by simp

definition mod_ring_rel :: "int \<Rightarrow> 'a mod_ring \<Rightarrow> bool" where
  "mod_ring_rel x x' = (x = to_int_mod_ring x')"

(* domain transfer rules *)
lemma Domainp_mod_ring_rel [transfer_domain_rule]:
  "Domainp (mod_ring_rel) = (\<lambda> v. v \<in> {0 ..< p})"
proof -
  {
    fix v :: int
    assume *: "0 \<le> v" "v < p"
    have "Domainp mod_ring_rel v"
    proof
      show "mod_ring_rel v (of_int_mod_ring v)" unfolding mod_ring_rel_def using * p by auto
    qed
  } note * = this
  show ?thesis
    by (intro ext iffI, insert range_to_int_mod_ring[where 'a = 'a] *, auto simp: mod_ring_rel_def p)
qed

(* left/right/bi-unique *)
lemma bi_unique_mod_ring_rel [transfer_rule]:
  "bi_unique mod_ring_rel" "left_unique mod_ring_rel" "right_unique mod_ring_rel"
  unfolding mod_ring_rel_def bi_unique_def left_unique_def right_unique_def
  by auto

(* left/right-total *)
lemma right_total_mod_ring_rel [transfer_rule]: "right_total mod_ring_rel"
  unfolding mod_ring_rel_def right_total_def by simp

(* ************************************************************************************ *)
subsubsection \<open>Transfer Rules\<close>

(* 0 / 1 *)
lemma mod_ring_0[transfer_rule]: "mod_ring_rel 0 0" unfolding mod_ring_rel_def by simp
lemma mod_ring_1[transfer_rule]: "mod_ring_rel 1 1" unfolding mod_ring_rel_def by simp

(* addition *)
lemma plus_p_mod_def: assumes x: "x \<in> {0 ..< p}" and y: "y \<in> {0 ..< p}"
  shows "plus_p p x y = ((x + y) mod p)"
proof (cases "p \<le> x + y")
  case False
  thus ?thesis using x y unfolding plus_p_def Let_def by auto
next
  case True
  from True x y have *: "p > 0" "0 \<le> x + y - p" "x + y - p < p" by auto
  from True have id: "plus_p p x y = x + y - p" unfolding plus_p_def by auto
  show ?thesis unfolding id using * using mod_pos_pos_trivial by fastforce
qed

lemma mod_ring_plus[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel ===> mod_ring_rel) (plus_p p) (+)"
proof -
  {
    fix x y :: "'a mod_ring"
    have "plus_p p (to_int_mod_ring x) (to_int_mod_ring y) = to_int_mod_ring (x + y)"
      by (transfer, subst plus_p_mod_def, auto, auto simp: p)
  } note * = this
  show ?thesis
    by (intro rel_funI, auto simp: mod_ring_rel_def *)
qed

(* subtraction *)
lemma minus_p_mod_def: assumes x: "x \<in> {0 ..< p}" and y: "y \<in> {0 ..< p}"
  shows "minus_p p x y = ((x - y) mod p)"
proof (cases "x - y < 0")
  case False
  thus ?thesis using x y unfolding minus_p_def Let_def by auto
next
  case True
  from True x y have *: "p > 0" "0 \<le> x - y + p" "x - y + p < p" by auto
  from True have id: "minus_p p x y = x - y + p" unfolding minus_p_def by auto
  show ?thesis unfolding id using * using mod_pos_pos_trivial by fastforce
qed

lemma mod_ring_minus[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel ===> mod_ring_rel) (minus_p p) (-)"
proof -
  {
    fix x y :: "'a mod_ring"
    have "minus_p p (to_int_mod_ring x) (to_int_mod_ring y) = to_int_mod_ring (x - y)"
      by (transfer, subst minus_p_mod_def, auto simp: p)
  } note * = this
  show ?thesis
    by (intro rel_funI, auto simp: mod_ring_rel_def *)
qed

(* unary minus *)
lemma mod_ring_uminus[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel) (uminus_p p) uminus"
proof -
  {
    fix x :: "'a mod_ring"
    have "uminus_p p (to_int_mod_ring x) = to_int_mod_ring (uminus x)"
      by (transfer, auto simp: uminus_p_def p)
  } note * = this
  show ?thesis
    by (intro rel_funI, auto simp: mod_ring_rel_def *)
qed

(* multiplication *)
lemma mod_ring_mult[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel ===> mod_ring_rel) (mult_p p) ((*))"
proof -
  {
    fix x y :: "'a mod_ring"
    have "mult_p p (to_int_mod_ring x) (to_int_mod_ring y) = to_int_mod_ring (x * y)"
      by (transfer, auto simp: mult_p_def p)
  } note * = this
  show ?thesis
    by (intro rel_funI, auto simp: mod_ring_rel_def *)
qed

(* equality *)
lemma mod_ring_eq[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel ===> (=)) (=) (=)"
  by (intro rel_funI, auto simp: mod_ring_rel_def)

(* power *)
lemma mod_ring_power[transfer_rule]: "(mod_ring_rel ===> (=) ===> mod_ring_rel) (power_p p) (^)"
proof (intro rel_funI, clarify, unfold binary_power[symmetric], goal_cases)
  fix x y n
  assume xy: "mod_ring_rel x y"
  from xy show "mod_ring_rel (power_p p x n) (binary_power y n)"
  proof (induct y n arbitrary: x rule: binary_power.induct)
    case (1 x n y)
    note 1(2)[transfer_rule]
    show ?case
    proof (cases "n = 0")
      case True
      thus ?thesis by (simp add: mod_ring_1)
    next
      case False
      obtain d r where id: "Euclidean_Rings.divmod_nat n 2 = (d,r)" by force
      let ?int = "power_p p (mult_p p y y) d"
      let ?gfp = "binary_power (x * x) d"
      from False have id': "?thesis = (mod_ring_rel
         (if r = 0 then ?int else mult_p p ?int y)
         (if r = 0 then ?gfp else ?gfp * x))"
        unfolding power_p.simps[of _ _ n] binary_power.simps[of _ n] Let_def id split by simp
      have [transfer_rule]: "mod_ring_rel ?int ?gfp"
        by (rule 1(1)[OF False refl id[symmetric]], transfer_prover)
      show ?thesis unfolding id' by transfer_prover
    qed
  qed
qed

declare power_p.simps[simp del]

lemma ring_finite_field_ops_int: "ring_ops (finite_field_ops_int p) mod_ring_rel"
  by (unfold_locales, auto simp:
  finite_field_ops_int_def
  bi_unique_mod_ring_rel
  right_total_mod_ring_rel
  mod_ring_plus
  mod_ring_minus
  mod_ring_uminus
  mod_ring_mult
  mod_ring_eq
  mod_ring_0
  mod_ring_1
  Domainp_mod_ring_rel)
end

locale prime_field = mod_ring_locale p ty for p and ty :: "'a :: prime_card itself"
begin

lemma prime: "prime p" unfolding p using prime_card[where 'a = 'a] by simp

(* mod *)
lemma mod_ring_mod[transfer_rule]:
 "(mod_ring_rel ===> mod_ring_rel ===> mod_ring_rel) ((\<lambda> x y. if y = 0 then x else 0)) (mod)"
proof -
  {
    fix x y :: "'a mod_ring"
    have "(if to_int_mod_ring y = 0 then to_int_mod_ring x else 0) = to_int_mod_ring (x mod y)"
      unfolding modulo_mod_ring_def by auto
  } note * = this
  show ?thesis
    by (intro rel_funI, auto simp: mod_ring_rel_def *[symmetric])
qed

(* normalize *)
lemma mod_ring_normalize[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel) ((\<lambda> x. if x = 0 then 0 else 1)) normalize"
proof -
  {
    fix x :: "'a mod_ring"
    have "(if to_int_mod_ring x = 0 then 0 else 1) = to_int_mod_ring (normalize x)"
      unfolding normalize_mod_ring_def by auto
  } note * = this
  show ?thesis
    by (intro rel_funI, auto simp: mod_ring_rel_def *[symmetric])
qed

(* unit_factor *)
lemma mod_ring_unit_factor[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel) (\<lambda> x. x) unit_factor"
proof -
  {
    fix x :: "'a mod_ring"
    have "to_int_mod_ring x = to_int_mod_ring (unit_factor x)"
      unfolding unit_factor_mod_ring_def by auto
  } note * = this
  show ?thesis
    by (intro rel_funI, auto simp: mod_ring_rel_def *[symmetric])
qed

(* inverse *)
lemma mod_ring_inverse[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel) (inverse_p p) inverse"
proof (intro rel_funI)
  fix x y
  assume [transfer_rule]: "mod_ring_rel x y"
  show "mod_ring_rel (inverse_p p x) (inverse y)"
    unfolding inverse_p_def inverse_mod_ring_def
    apply (transfer_prover_start)
    apply (transfer_step)+
    apply (unfold p2_ident)
    apply (rule refl)
    done
qed

(* division *)
lemma mod_ring_divide[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel ===> mod_ring_rel)
  (divide_p p) (/)"
  unfolding divide_p_def[abs_def] divide_mod_ring_def[abs_def] inverse_mod_ring_def[symmetric]
  by transfer_prover

lemma mod_ring_rel_unsafe: assumes "x < CARD('a)"
  shows "mod_ring_rel (int x) (of_nat x)" "0 < x \<Longrightarrow> of_nat x \<noteq> (0 :: 'a mod_ring)"
proof -
  have id: "of_nat x = (of_int (int x) :: 'a mod_ring)" by simp
  show "mod_ring_rel (int x) (of_nat x)" "0 < x \<Longrightarrow> of_nat x \<noteq> (0 :: 'a mod_ring)" unfolding id
  unfolding mod_ring_rel_def
  proof (auto simp add: assms of_int_of_int_mod_ring)
    assume "0 < x" with assms
    have "of_int_mod_ring (int x) \<noteq> (0 :: 'a mod_ring)"
      by (metis (no_types) less_imp_of_nat_less less_irrefl of_nat_0_le_iff of_nat_0_less_iff to_int_mod_ring_hom.hom_zero to_int_mod_ring_of_int_mod_ring)
    thus "of_int_mod_ring (int x) = (0 :: 'a mod_ring) \<Longrightarrow> False" by blast
  qed
qed

lemma finite_field_ops_int: "field_ops (finite_field_ops_int p) mod_ring_rel"
  by (unfold_locales, auto simp:
  finite_field_ops_int_def
  bi_unique_mod_ring_rel
  right_total_mod_ring_rel
  mod_ring_divide
  mod_ring_plus
  mod_ring_minus
  mod_ring_uminus
  mod_ring_inverse
  mod_ring_mod
  mod_ring_unit_factor
  mod_ring_normalize
  mod_ring_mult
  mod_ring_eq
  mod_ring_0
  mod_ring_1
  Domainp_mod_ring_rel)

end

text \<open>Once we have proven the soundness of the implementation, we do not care any longer
  that @{typ "'a mod_ring"} has been defined internally via lifting. Disabling the transfer-rules
  will hide the internal definition in further applications of transfer.\<close>
lifting_forget mod_ring.lifting

text \<open>For soundness of the 32-bit implementation, we mainly prove that this implementation
  implements the int-based implementation of the mod-ring.\<close>
context mod_ring_locale
begin

context fixes pp :: "uint32"
  assumes ppp: "p = int_of_uint32 pp"
  and small: "p \<le> 65535"
begin

lemmas uint32_simps =
  int_of_uint32_0
  int_of_uint32_plus
  int_of_uint32_minus
  int_of_uint32_mult

definition urel32 :: "uint32 \<Rightarrow> int \<Rightarrow> bool" where "urel32 x y = (y = int_of_uint32 x \<and> y < p)"

definition mod_ring_rel32 :: "uint32 \<Rightarrow> 'a mod_ring \<Rightarrow> bool" where
  "mod_ring_rel32 x y = (\<exists> z. urel32 x z \<and> mod_ring_rel z y)"

lemma urel32_0: "urel32 0 0" unfolding urel32_def using p2 by (simp, transfer, simp)

lemma urel32_1: "urel32 1 1" unfolding urel32_def using p2 by (simp, transfer, simp)

lemma le_int_of_uint32: "(x \<le> y) = (int_of_uint32 x \<le> int_of_uint32 y)"
  by (transfer, simp add: word_le_def)

lemma urel32_plus: assumes "urel32 x y" "urel32 x' y'"
  shows "urel32 (plus_p32 pp x x') (plus_p p y y')"
proof -
  let ?x = "int_of_uint32 x"
  let ?x' = "int_of_uint32 x'"
  let ?p = "int_of_uint32 pp"
  from assms int_of_uint32_ge_0 have id: "y = ?x" "y' = ?x'"
    and rel: "0 \<le> ?x" "?x < p"
      "0 \<le> ?x'" "?x' \<le> p" unfolding urel32_def by auto
  have le: "(pp \<le> x + x') = (?p \<le> ?x + ?x')" unfolding le_int_of_uint32
    using rel small by (auto simp: uint32_simps)
  show ?thesis
  proof (cases "?p \<le> ?x + ?x'")
    case True
    hence True: "(?p \<le> ?x + ?x') = True" by simp
    show ?thesis unfolding id
      using small rel unfolding plus_p32_def plus_p_def Let_def urel32_def
      unfolding ppp le True if_True
      using True by (auto simp: uint32_simps)
  next
    case False
    hence False: "(?p \<le> ?x + ?x') = False" by simp
    show ?thesis unfolding id
      using small rel unfolding plus_p32_def plus_p_def Let_def urel32_def
      unfolding ppp le False if_False
      using False by (auto simp: uint32_simps)
  qed
qed

lemma urel32_uminus: assumes "urel32 x y"
  shows "urel32 (uminus_p32 pp x) (uminus_p p y)"
proof -
  let ?x = "int_of_uint32 x"
  from assms int_of_uint32_ge_0 have id: "y = ?x"
    and rel: "0 \<le> ?x" "?x < p"
      unfolding urel32_def by auto
  have le: "(x = 0) = (?x = 0)" unfolding int_of_uint32_0_iff
    using rel small by (auto simp: uint32_simps)
  show ?thesis
  proof (cases "?x = 0")
    case True
    hence True: "(?x = 0) = True" by simp
    show ?thesis unfolding id
      using small rel unfolding uminus_p32_def uminus_p_def Let_def urel32_def
      unfolding ppp le True if_True
      using True by (auto simp: uint32_simps)
  next
    case False
    hence False: "(?x = 0) = False" by simp
    show ?thesis unfolding id
      using small rel unfolding uminus_p32_def uminus_p_def Let_def urel32_def
      unfolding ppp le False if_False
      using False by (auto simp: uint32_simps)
  qed
qed

lemma urel32_mult: assumes "urel32 x y" "urel32 x' y'"
  shows "urel32 (mult_p32 pp x x') (mult_p p y y')"
proof -
  let ?x = "int_of_uint32 x"
  let ?x' = "int_of_uint32 x'"
  from assms int_of_uint32_ge_0 have id: "y = ?x" "y' = ?x'"
    and rel: "0 \<le> ?x" "?x < p"
      "0 \<le> ?x'" "?x' < p" unfolding urel32_def by auto
  from rel have "?x * ?x' < p * p" by (metis mult_strict_mono')
  also have "\<dots> \<le> 65536 * 65536"
    by (rule mult_mono, insert p2 small, auto)
  finally have le: "?x * ?x' < 4294967296" by simp
  show ?thesis unfolding id
      using small rel unfolding mult_p32_def mult_p_def Let_def urel32_def
      unfolding ppp
    by (auto simp: uint32_simps, unfold int_of_uint32_mod int_of_uint32_mult,
        subst mod_pos_pos_trivial[of _ 4294967296], insert le, auto)
qed

lemma urel32_eq: assumes "urel32 x y" "urel32 x' y'"
  shows "(x = x') = (y = y')"
proof -
  let ?x = "int_of_uint32 x"
  let ?x' = "int_of_uint32 x'"
  from assms int_of_uint32_ge_0 have id: "y = ?x" "y' = ?x'"
    unfolding urel32_def by auto
  show ?thesis unfolding id by (transfer, transfer) rule
qed

lemma urel32_normalize:
assumes x: "urel32 x y"
shows "urel32 (if x = 0 then 0 else 1) (if y = 0 then 0 else 1)"
 unfolding urel32_eq[OF x urel32_0] using urel32_0 urel32_1 by auto

lemma urel32_mod:
assumes x: "urel32 x x'" and y: "urel32 y y'"
shows "urel32 (if y = 0 then x else 0) (if y' = 0 then x' else 0)"
  unfolding urel32_eq[OF y urel32_0] using urel32_0 x by auto

lemma urel32_inverse: assumes x: "urel32 x x'"
  shows "urel32 (inverse_p32 pp x) (inverse_p p x')"
proof -
  have p: "urel32 (pp - 2) (int (nat (p - 2)))" using p2 small unfolding urel32_def unfolding ppp
    by (simp add: int_of_uint32.rep_eq minus_uint32.rep_eq uint_sub_if')
  show ?thesis
    unfolding inverse_p32_def inverse_p_def urel32_eq[OF x urel32_0] using urel32_0 urel32_power[OF x p]
    by auto
qed

lemma mod_ring_0_32: "mod_ring_rel32 0 0"
  using urel32_0 mod_ring_0 unfolding mod_ring_rel32_def by blast

lemma mod_ring_1_32: "mod_ring_rel32 1 1"
  using urel32_1 mod_ring_1 unfolding mod_ring_rel32_def by blast

lemma mod_ring_uminus32: "(mod_ring_rel32 ===> mod_ring_rel32) (uminus_p32 pp) uminus"
  using urel32_uminus mod_ring_uminus unfolding mod_ring_rel32_def rel_fun_def by blast

lemma mod_ring_plus32: "(mod_ring_rel32 ===> mod_ring_rel32 ===> mod_ring_rel32) (plus_p32 pp) (+)"
  using urel32_plus mod_ring_plus unfolding mod_ring_rel32_def rel_fun_def by blast

lemma mod_ring_minus32: "(mod_ring_rel32 ===> mod_ring_rel32 ===> mod_ring_rel32) (minus_p32 pp) (-)"
  using urel32_minus mod_ring_minus unfolding mod_ring_rel32_def rel_fun_def by blast

lemma mod_ring_mult32: "(mod_ring_rel32 ===> mod_ring_rel32 ===> mod_ring_rel32) (mult_p32 pp) ((*))"
  using urel32_mult mod_ring_mult unfolding mod_ring_rel32_def rel_fun_def by blast

lemma mod_ring_eq32: "(mod_ring_rel32 ===> mod_ring_rel32 ===> (=)) (=) (=)"
  using urel32_eq mod_ring_eq unfolding mod_ring_rel32_def rel_fun_def by blast

lemma urel32_inj: "urel32 x y \<Longrightarrow> urel32 x z \<Longrightarrow> y = z"
  using urel32_eq[of x y x z] by auto

lemma urel32_inj': "urel32 x z \<Longrightarrow> urel32 y z \<Longrightarrow> x = y"
  using urel32_eq[of x z y z] by auto

lemma bi_unique_mod_ring_rel32:
  "bi_unique mod_ring_rel32" "left_unique mod_ring_rel32" "right_unique mod_ring_rel32"
  using bi_unique_mod_ring_rel urel32_inj'
  unfolding mod_ring_rel32_def bi_unique_def left_unique_def right_unique_def
  by (auto simp: urel32_def)

lemma right_total_mod_ring_rel32: "right_total mod_ring_rel32"
  unfolding mod_ring_rel32_def right_total_def
proof
  fix y :: "'a mod_ring"
  from right_total_mod_ring_rel[unfolded right_total_def, rule_format, of y]
  obtain z where zy: "mod_ring_rel z y" by auto
  hence zp: "0 \<le> z" "z < p" unfolding mod_ring_rel_def p using range_to_int_mod_ring[where 'a = 'a] by auto
  hence "urel32 (uint32_of_int z) z" unfolding urel32_def using small unfolding ppp
    by (auto simp: int_of_uint32_inv)
  with zy show "\<exists> x z. urel32 x z \<and> mod_ring_rel z y" by blast
qed

lemma Domainp_mod_ring_rel32: "Domainp mod_ring_rel32 = (\<lambda>x. 0 \<le> x \<and> x < pp)"
proof
  fix x
  show "Domainp mod_ring_rel32 x = (0 \<le> x \<and> x < pp)"
    unfolding Domainp.simps
    unfolding mod_ring_rel32_def
  proof
    let ?i = "int_of_uint32"
    assume *: "0 \<le> x \<and> x < pp"
    hence "0 \<le> ?i x \<and> ?i x < p" using small unfolding ppp
      by (transfer, auto simp: word_less_def)
    hence "?i x \<in> {0 ..< p}" by auto
    with Domainp_mod_ring_rel
    have "Domainp mod_ring_rel (?i x)" by auto
    from this[unfolded Domainp.simps]
    obtain b where b: "mod_ring_rel (?i x) b" by auto
    show "\<exists>a b. x = a \<and> (\<exists>z. urel32 a z \<and> mod_ring_rel z b)"
    proof (intro exI, rule conjI[OF refl], rule exI, rule conjI[OF _ b])
      show "urel32 x (?i x)" unfolding urel32_def using small * unfolding ppp
        by (transfer, auto simp: word_less_def)
    qed
  next
    assume "\<exists>a b. x = a \<and> (\<exists>z. urel32 a z \<and> mod_ring_rel z b)"
    then obtain b z where xz: "urel32 x z" and zb: "mod_ring_rel z b" by auto
    hence "Domainp mod_ring_rel z"  by auto
    with Domainp_mod_ring_rel have "0 \<le> z" "z < p" by auto
    with xz show "0 \<le> x \<and> x < pp" unfolding urel32_def using small unfolding ppp
      by (transfer, auto simp: word_less_def)
  qed
qed

lemma ring_finite_field_ops32: "ring_ops (finite_field_ops32 pp) mod_ring_rel32"
  by (unfold_locales, auto simp:
  finite_field_ops32_def
  bi_unique_mod_ring_rel32
  right_total_mod_ring_rel32
  mod_ring_plus32
  mod_ring_minus32
  mod_ring_uminus32
  mod_ring_mult32
  mod_ring_eq32
  mod_ring_0_32
  mod_ring_1_32
  Domainp_mod_ring_rel32)
end
end

context prime_field
begin
context fixes pp :: "uint32"
  assumes *: "p = int_of_uint32 pp" "p \<le> 65535"
begin

lemma mod_ring_mod32: "(mod_ring_rel32 ===> mod_ring_rel32 ===> mod_ring_rel32) (\<lambda>x y. if y = 0 then x else 0) (mod)"
  using urel32_mod[OF *] mod_ring_mod unfolding mod_ring_rel32_def[OF *] rel_fun_def by blast

lemma mod_ring_unit_factor32: "(mod_ring_rel32 ===> mod_ring_rel32) (\<lambda>x. x) unit_factor"
  using mod_ring_unit_factor unfolding mod_ring_rel32_def[OF *] rel_fun_def by blast

lemma mod_ring_inverse32: "(mod_ring_rel32 ===> mod_ring_rel32) (inverse_p32 pp) inverse"
  using urel32_inverse[OF *] mod_ring_inverse unfolding mod_ring_rel32_def[OF *] rel_fun_def by blast

lemma mod_ring_divide32: "(mod_ring_rel32 ===> mod_ring_rel32 ===> mod_ring_rel32) (divide_p32 pp) (/)"
  using mod_ring_inverse32 mod_ring_mult32[OF *]
  unfolding divide_p32_def divide_mod_ring_def inverse_mod_ring_def[symmetric]
    rel_fun_def by blast

lemma finite_field_ops32: "field_ops (finite_field_ops32 pp) mod_ring_rel32"
  by (unfold_locales, insert ring_finite_field_ops32[OF *], auto simp:
  ring_ops_def
  finite_field_ops32_def
  mod_ring_divide32
  mod_ring_inverse32
  mod_ring_mod32
  mod_ring_normalize32)

end
end

(* now there is 64-bit time *)
context
  fixes p :: uint64
begin
definition plus_p64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64" where
  "plus_p64 x y \<equiv> let z = x + y in if z \<ge> p then z - p else z"

definition minus_p64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64" where
  "minus_p64 x y \<equiv> if y \<le> x then x - y else (x + p) - y"

definition uminus_p64 :: "uint64 \<Rightarrow> uint64" where
  "uminus_p64 x = (if x = 0 then 0 else p - x)"

definition mult_p64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64" where
  "mult_p64 x y = (x * y mod p)"

lemma int_of_uint64_shift: "int_of_uint64 (drop_bit k n) = (int_of_uint64 n) div (2 ^ k)"
  apply transfer
  apply transfer
  apply (simp add: take_bit_drop_bit min_def)
  apply (simp add: drop_bit_eq_div)
  done

lemma int_of_uint64_0_iff: "int_of_uint64 n = 0 \<longleftrightarrow> n = 0"
  by (transfer, rule uint_0_iff)

lemma int_of_uint64_0: "int_of_uint64 0 = 0" unfolding int_of_uint64_0_iff by simp

lemma int_of_uint64_ge_0: "int_of_uint64 n \<ge> 0"
  by (transfer, auto)

lemma two_64: "2 ^ LENGTH(64) = (18446744073709551616 :: int)" by simp

lemma int_of_uint64_plus: "int_of_uint64 (x + y) = (int_of_uint64 x + int_of_uint64 y) mod 18446744073709551616"
  by (transfer, unfold uint_word_ariths two_64, rule refl)

lemma int_of_uint64_minus: "int_of_uint64 (x - y) = (int_of_uint64 x - int_of_uint64 y) mod 18446744073709551616"
  by (transfer, unfold uint_word_ariths two_64, rule refl)

lemma int_of_uint64_mult: "int_of_uint64 (x * y) = (int_of_uint64 x * int_of_uint64 y) mod 18446744073709551616"
  by (transfer, unfold uint_word_ariths two_64, rule refl)

lemma int_of_uint64_mod: "int_of_uint64 (x mod y) = (int_of_uint64 x mod int_of_uint64 y)"
  by (transfer, unfold uint_mod two_64, rule refl)

lemma int_of_uint64_inv: "0 \<le> x \<Longrightarrow> x < 18446744073709551616 \<Longrightarrow> int_of_uint64 (uint64_of_int x) = x"
  by transfer (simp add: take_bit_int_eq_self unsigned_of_int)

context
  includes bit_operations_syntax
begin

function power_p64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64" where
  "power_p64 x n = (if n = 0 then 1 else
    let rec = power_p64 (mult_p64 x x) (drop_bit 1 n) in
    if n AND 1 = 0 then rec else mult_p64 rec x)"
  by pat_completeness auto

termination
proof -
  {
    fix n :: uint64
    assume "n \<noteq> 0"
    with int_of_uint64_ge_0[of n] int_of_uint64_0_iff[of n] have "int_of_uint64 n > 0" by auto
    hence "0 < int_of_uint64 n" "int_of_uint64 n div 2 < int_of_uint64 n" by auto
  } note * = this
  show ?thesis
    by (relation "measure (\<lambda> (x,n). nat (int_of_uint64 n))", auto simp: int_of_uint64_shift *)
qed

end

text \<open>In experiments with Berlekamp-factorization (where the prime $p$ is usually small),
  it turned out that taking the below implementation of inverse via exponentiation
  is faster than the one based on the extended Euclidean algorithm.\<close>

definition inverse_p64 :: "uint64 \<Rightarrow> uint64" where
  "inverse_p64 x = (if x = 0 then 0 else power_p64 x (p - 2))"

definition divide_p64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64"  where
  "divide_p64 x y = mult_p64 x (inverse_p64 y)"

definition finite_field_ops64 :: "uint64 arith_ops_record" where
  "finite_field_ops64 \<equiv> Arith_Ops_Record
      0
      1
      plus_p64
      mult_p64
      minus_p64
      uminus_p64
      divide_p64
      inverse_p64
      (\<lambda> x y . if y = 0 then x else 0)
      (\<lambda> x . if x = 0 then 0 else 1)
      (\<lambda> x . x)
      uint64_of_int
      int_of_uint64
      (\<lambda> x. 0 \<le> x \<and> x < p)"
end

lemma shiftr_uint64_code [code_unfold]: "drop_bit 1 x = (uint64_shiftr x 1)"
  by (simp add: uint64_shiftr_def)

text \<open>For soundness of the 64-bit implementation, we mainly prove that this implementation
  implements the int-based implementation of GF(p).\<close>
context mod_ring_locale
begin

context fixes pp :: "uint64"
  assumes ppp: "p = int_of_uint64 pp"
  and small: "p \<le> 4294967295"
begin

lemmas uint64_simps =
  int_of_uint64_0
  int_of_uint64_plus
  int_of_uint64_minus
  int_of_uint64_mult

definition urel64 :: "uint64 \<Rightarrow> int \<Rightarrow> bool" where "urel64 x y = (y = int_of_uint64 x \<and> y < p)"

definition mod_ring_rel64 :: "uint64 \<Rightarrow> 'a mod_ring \<Rightarrow> bool" where
  "mod_ring_rel64 x y = (\<exists> z. urel64 x z \<and> mod_ring_rel z y)"

lemma urel64_0: "urel64 0 0" unfolding urel64_def using p2 by (simp, transfer, simp)

lemma urel64_1: "urel64 1 1" unfolding urel64_def using p2 by (simp, transfer, simp)

lemma le_int_of_uint64: "(x \<le> y) = (int_of_uint64 x \<le> int_of_uint64 y)"
  by (transfer, simp add: word_le_def)

lemma urel64_plus: assumes "urel64 x y" "urel64 x' y'"
  shows "urel64 (plus_p64 pp x x') (plus_p p y y')"
proof -
  let ?x = "int_of_uint64 x"
  let ?x' = "int_of_uint64 x'"
  let ?p = "int_of_uint64 pp"
  from assms int_of_uint64_ge_0 have id: "y = ?x" "y' = ?x'"
    and rel: "0 \<le> ?x" "?x < p"
      "0 \<le> ?x'" "?x' \<le> p" unfolding urel64_def by auto
  have le: "(pp \<le> x + x') = (?p \<le> ?x + ?x')" unfolding le_int_of_uint64
    using rel small by (auto simp: uint64_simps)
  show ?thesis
  proof (cases "?p \<le> ?x + ?x'")
    case True
    hence True: "(?p \<le> ?x + ?x') = True" by simp
    show ?thesis unfolding id
      using small rel unfolding plus_p64_def plus_p_def Let_def urel64_def
      unfolding ppp le True if_True
      using True by (auto simp: uint64_simps)
  next
    case False
    hence False: "(?p \<le> ?x + ?x') = False" by simp
    show ?thesis unfolding id
      using small rel unfolding plus_p64_def plus_p_def Let_def urel64_def
      unfolding ppp le False if_False
      using False by (auto simp: uint64_simps)
  qed
qed

lemma urel64_minus: assumes "urel64 x y" "urel64 x' y'"
  shows "urel64 (minus_p64 pp x x') (minus_p p y y')"
proof -
  let ?x = "int_of_uint64 x"
  let ?x' = "int_of_uint64 x'"
  from assms int_of_uint64_ge_0 have id: "y = ?x" "y' = ?x'"
    and rel: "0 \<le> ?x" "?x < p"
      "0 \<le> ?x'" "?x' \<le> p" unfolding urel64_def by auto
  have le: "(x' \<le> x) = (?x' \<le> ?x)" unfolding le_int_of_uint64
    using rel small by (auto simp: uint64_simps)
  show ?thesis
  proof (cases "?x' \<le> ?x")
    case True
    hence True: "(?x' \<le> ?x) = True" by simp
    show ?thesis unfolding id
      using small rel unfolding minus_p64_def minus_p_def Let_def urel64_def
      unfolding ppp le True if_True
      using True by (auto simp: uint64_simps)
  next
    case False
    hence False: "(?x' \<le> ?x) = False" by simp
    show ?thesis unfolding id
      using small rel unfolding minus_p64_def minus_p_def Let_def urel64_def
      unfolding ppp le False if_False
      using False by (auto simp: uint64_simps)
  qed
qed

lemma urel64_uminus: assumes "urel64 x y"
  shows "urel64 (uminus_p64 pp x) (uminus_p p y)"
proof -
  let ?x = "int_of_uint64 x"
  from assms int_of_uint64_ge_0 have id: "y = ?x"
    and rel: "0 \<le> ?x" "?x < p"
      unfolding urel64_def by auto
  have le: "(x = 0) = (?x = 0)" unfolding int_of_uint64_0_iff
    using rel small by (auto simp: uint64_simps)
  show ?thesis
  proof (cases "?x = 0")
    case True
    hence True: "(?x = 0) = True" by simp
    show ?thesis unfolding id
      using small rel unfolding uminus_p64_def uminus_p_def Let_def urel64_def
      unfolding ppp le True if_True
      using True by (auto simp: uint64_simps)
  next
    case False
    hence False: "(?x = 0) = False" by simp
    show ?thesis unfolding id
      using small rel unfolding uminus_p64_def uminus_p_def Let_def urel64_def
      unfolding ppp le False if_False
      using False by (auto simp: uint64_simps)
  qed
qed

lemma urel64_mult: assumes "urel64 x y" "urel64 x' y'"
  shows "urel64 (mult_p64 pp x x') (mult_p p y y')"
proof -
  let ?x = "int_of_uint64 x"
  let ?x' = "int_of_uint64 x'"
  from assms int_of_uint64_ge_0 have id: "y = ?x" "y' = ?x'"
    and rel: "0 \<le> ?x" "?x < p"
      "0 \<le> ?x'" "?x' < p" unfolding urel64_def by auto
  from rel have "?x * ?x' < p * p" by (metis mult_strict_mono')
  also have "\<dots> \<le> 4294967296 * 4294967296"
    by (rule mult_mono, insert p2 small, auto)
  finally have le: "?x * ?x' < 18446744073709551616" by simp
  show ?thesis unfolding id
      using small rel unfolding mult_p64_def mult_p_def Let_def urel64_def
      unfolding ppp
    by (auto simp: uint64_simps, unfold int_of_uint64_mod int_of_uint64_mult,
        subst mod_pos_pos_trivial[of _ 18446744073709551616], insert le, auto)
qed

lemma urel64_eq: assumes "urel64 x y" "urel64 x' y'"
  shows "(x = x') = (y = y')"
proof -
  let ?x = "int_of_uint64 x"
  let ?x' = "int_of_uint64 x'"
  from assms int_of_uint64_ge_0 have id: "y = ?x" "y' = ?x'"
    unfolding urel64_def by auto
  show ?thesis unfolding id by (transfer, transfer) rule
qed

lemma urel64_normalize:
assumes x: "urel64 x y"
shows "urel64 (if x = 0 then 0 else 1) (if y = 0 then 0 else 1)"
 unfolding urel64_eq[OF x urel64_0] using urel64_0 urel64_1 by auto

lemma urel64_mod:
assumes x: "urel64 x x'" and y: "urel64 y y'"
shows "urel64 (if y = 0 then x else 0) (if y' = 0 then x' else 0)"
  unfolding urel64_eq[OF y urel64_0] using urel64_0 x by auto

lemma urel64_power: "urel64 x x' \<Longrightarrow> urel64 y (int y') \<Longrightarrow> urel64 (power_p64 pp x y) (power_p p x' y')"
including bit_operations_syntax proof (induct x' y' arbitrary: x y rule: power_p.induct[of _ p])
  case (1 x' y' x y)
  note x = 1(2) note y = 1(3)
  show ?case
  proof (cases "y' = 0")
    case True
    hence y: "y = 0" using urel64_eq[OF y urel64_0] by auto
    show ?thesis unfolding y True by (simp add: power_p.simps urel64_1)
  next
    case False
    hence id: "(y = 0) = False" "(y' = 0) = False" using urel64_eq[OF y urel64_0] by auto
    from y have \<open>int y' = int_of_uint64 y\<close> \<open>int y' < p\<close>
      by (simp_all add: urel64_def)
    obtain d' r' where dr': "Euclidean_Rings.divmod_nat y' 2 = (d',r')" by force
    from Euclidean_Rings.divmod_nat_def[of y' 2, unfolded dr']
    have r': "r' = y' mod 2" and d': "d' = y' div 2" by auto
    have "urel64 (y AND 1) r'"
      using \<open>int y' < p\<close> small
      apply (simp add: urel64_def and_one_eq r')
      apply (auto simp add: ppp and_one_eq)
      apply (simp add: of_nat_mod int_of_uint64.rep_eq modulo_uint64.rep_eq uint_mod \<open>int y' = int_of_uint64 y\<close>)
      done
    from urel64_eq[OF this urel64_0]
    have rem: "(y AND 1 = 0) = (r' = 0)" by simp
    have div: "urel64 (drop_bit 1 y) (int d')" unfolding d' using y unfolding urel64_def using small
      unfolding ppp
      apply transfer
      apply transfer
      apply (auto simp add: drop_bit_Suc take_bit_int_eq_self)
      done
    note IH = 1(1)[OF False refl dr'[symmetric] urel64_mult[OF x x] div]
    show ?thesis unfolding power_p.simps[of _ _ "y'"] power_p64.simps[of _ _ y] dr' id if_False rem
      using IH urel64_mult[OF IH x] by (auto simp: Let_def)
  qed
qed

lemma urel64_inverse: assumes x: "urel64 x x'"
  shows "urel64 (inverse_p64 pp x) (inverse_p p x')"
proof -
  have p: "urel64 (pp - 2) (int (nat (p - 2)))" using p2 small unfolding urel64_def unfolding ppp
    by (simp add: int_of_uint64.rep_eq minus_uint64.rep_eq uint_sub_if')
  show ?thesis
    unfolding inverse_p64_def inverse_p_def urel64_eq[OF x urel64_0] using urel64_0 urel64_power[OF x p]
    by auto
qed

lemma mod_ring_0_64: "mod_ring_rel64 0 0"
  using urel64_0 mod_ring_0 unfolding mod_ring_rel64_def by blast

lemma mod_ring_1_64: "mod_ring_rel64 1 1"
  using urel64_1 mod_ring_1 unfolding mod_ring_rel64_def by blast

lemma mod_ring_uminus64: "(mod_ring_rel64 ===> mod_ring_rel64) (uminus_p64 pp) uminus"
  using urel64_uminus mod_ring_uminus unfolding mod_ring_rel64_def rel_fun_def by blast

lemma mod_ring_plus64: "(mod_ring_rel64 ===> mod_ring_rel64 ===> mod_ring_rel64) (plus_p64 pp) (+)"
  using urel64_plus mod_ring_plus unfolding mod_ring_rel64_def rel_fun_def by blast

lemma mod_ring_minus64: "(mod_ring_rel64 ===> mod_ring_rel64 ===> mod_ring_rel64) (minus_p64 pp) (-)"
  using urel64_minus mod_ring_minus unfolding mod_ring_rel64_def rel_fun_def by blast

lemma mod_ring_mult64: "(mod_ring_rel64 ===> mod_ring_rel64 ===> mod_ring_rel64) (mult_p64 pp) ((*))"
  using urel64_mult mod_ring_mult unfolding mod_ring_rel64_def rel_fun_def by blast

lemma mod_ring_eq64: "(mod_ring_rel64 ===> mod_ring_rel64 ===> (=)) (=) (=)"
  using urel64_eq mod_ring_eq unfolding mod_ring_rel64_def rel_fun_def by blast

lemma urel64_inj: "urel64 x y \<Longrightarrow> urel64 x z \<Longrightarrow> y = z"
  using urel64_eq[of x y x z] by auto

lemma urel64_inj': "urel64 x z \<Longrightarrow> urel64 y z \<Longrightarrow> x = y"
  using urel64_eq[of x z y z] by auto

lemma bi_unique_mod_ring_rel64:
  "bi_unique mod_ring_rel64" "left_unique mod_ring_rel64" "right_unique mod_ring_rel64"
  using bi_unique_mod_ring_rel urel64_inj'
  unfolding mod_ring_rel64_def bi_unique_def left_unique_def right_unique_def
  by (auto simp: urel64_def)

lemma right_total_mod_ring_rel64: "right_total mod_ring_rel64"
  unfolding mod_ring_rel64_def right_total_def
proof
  fix y :: "'a mod_ring"
  from right_total_mod_ring_rel[unfolded right_total_def, rule_format, of y]
  obtain z where zy: "mod_ring_rel z y" by auto
  hence zp: "0 \<le> z" "z < p" unfolding mod_ring_rel_def p using range_to_int_mod_ring[where 'a = 'a] by auto
  hence "urel64 (uint64_of_int z) z" unfolding urel64_def using small unfolding ppp
    by (auto simp: int_of_uint64_inv)
  with zy show "\<exists> x z. urel64 x z \<and> mod_ring_rel z y" by blast
qed

lemma Domainp_mod_ring_rel64: "Domainp mod_ring_rel64 = (\<lambda>x. 0 \<le> x \<and> x < pp)"
proof
  fix x
  show "Domainp mod_ring_rel64 x = (0 \<le> x \<and> x < pp)"
    unfolding Domainp.simps
    unfolding mod_ring_rel64_def
  proof
    let ?i = "int_of_uint64"
    assume *: "0 \<le> x \<and> x < pp"
    hence "0 \<le> ?i x \<and> ?i x < p" using small unfolding ppp
      by (transfer, auto simp: word_less_def)
    hence "?i x \<in> {0 ..< p}" by auto
    with Domainp_mod_ring_rel
    have "Domainp mod_ring_rel (?i x)" by auto
    from this[unfolded Domainp.simps]
    obtain b where b: "mod_ring_rel (?i x) b" by auto
    show "\<exists>a b. x = a \<and> (\<exists>z. urel64 a z \<and> mod_ring_rel z b)"
    proof (intro exI, rule conjI[OF refl], rule exI, rule conjI[OF _ b])
      show "urel64 x (?i x)" unfolding urel64_def using small * unfolding ppp
        by (transfer, auto simp: word_less_def)
    qed
  next
    assume "\<exists>a b. x = a \<and> (\<exists>z. urel64 a z \<and> mod_ring_rel z b)"
    then obtain b z where xz: "urel64 x z" and zb: "mod_ring_rel z b" by auto
    hence "Domainp mod_ring_rel z"  by auto
    with Domainp_mod_ring_rel have "0 \<le> z" "z < p" by auto
    with xz show "0 \<le> x \<and> x < pp" unfolding urel64_def using small unfolding ppp
      by (transfer, auto simp: word_less_def)
  qed
qed

lemma ring_finite_field_ops64: "ring_ops (finite_field_ops64 pp) mod_ring_rel64"
  by (unfold_locales, auto simp:
  finite_field_ops64_def
  bi_unique_mod_ring_rel64
  right_total_mod_ring_rel64
  mod_ring_plus64
  mod_ring_minus64
  mod_ring_uminus64
  mod_ring_mult64
  mod_ring_eq64
  mod_ring_0_64
  mod_ring_1_64
  Domainp_mod_ring_rel64)
end
end

context prime_field
begin
context fixes pp :: "uint64"
  assumes *: "p = int_of_uint64 pp" "p \<le> 4294967295"
begin

lemma mod_ring_normalize64: "(mod_ring_rel64 ===> mod_ring_rel64) (\<lambda>x. if x = 0 then 0 else 1) normalize"
  using urel64_normalize[OF *] mod_ring_normalize unfolding mod_ring_rel64_def[OF *] rel_fun_def by blast

lemma mod_ring_mod64: "(mod_ring_rel64 ===> mod_ring_rel64 ===> mod_ring_rel64) (\<lambda>x y. if y = 0 then x else 0) (mod)"
  using urel64_mod[OF *] mod_ring_mod unfolding mod_ring_rel64_def[OF *] rel_fun_def by blast

lemma mod_ring_unit_factor64: "(mod_ring_rel64 ===> mod_ring_rel64) (\<lambda>x. x) unit_factor"
  using mod_ring_unit_factor unfolding mod_ring_rel64_def[OF *] rel_fun_def by blast

lemma mod_ring_inverse64: "(mod_ring_rel64 ===> mod_ring_rel64) (inverse_p64 pp) inverse"
  using urel64_inverse[OF *] mod_ring_inverse unfolding mod_ring_rel64_def[OF *] rel_fun_def by blast

lemma mod_ring_divide64: "(mod_ring_rel64 ===> mod_ring_rel64 ===> mod_ring_rel64) (divide_p64 pp) (/)"
  using mod_ring_inverse64 mod_ring_mult64[OF *]
  unfolding divide_p64_def divide_mod_ring_def inverse_mod_ring_def[symmetric]
    rel_fun_def by blast

lemma finite_field_ops64: "field_ops (finite_field_ops64 pp) mod_ring_rel64"
  by (unfold_locales, insert ring_finite_field_ops64[OF *], auto simp:
  ring_ops_def
  finite_field_ops64_def
  mod_ring_divide64
  mod_ring_inverse64
  mod_ring_mod64
  mod_ring_normalize64)
end
end

(* and a final implementation via integer *)
context
  fixes p :: integer
begin
definition plus_p_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer" where
  "plus_p_integer x y \<equiv> let z = x + y in if z \<ge> p then z - p else z"

definition minus_p_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer" where
  "minus_p_integer x y \<equiv> if y \<le> x then x - y else (x + p) - y"

definition uminus_p_integer :: "integer \<Rightarrow> integer" where
  "uminus_p_integer x = (if x = 0 then 0 else p - x)"

definition mult_p_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer" where
  "mult_p_integer x y = (x * y mod p)"

lemma int_of_integer_0_iff: "int_of_integer n = 0 \<longleftrightarrow> n = 0"
  using integer_eqI by auto

lemma int_of_integer_0: "int_of_integer 0 = 0" unfolding int_of_integer_0_iff by simp

lemma int_of_integer_plus: "int_of_integer (x + y) = (int_of_integer x + int_of_integer y)"
  by simp

lemma int_of_integer_minus: "int_of_integer (x - y) = (int_of_integer x - int_of_integer y)"
  by simp

lemma int_of_integer_mult: "int_of_integer (x * y) = (int_of_integer x * int_of_integer y)"
  by simp

lemma int_of_integer_mod: "int_of_integer (x mod y) = (int_of_integer x mod int_of_integer y)"
  by simp

lemma int_of_integer_inv: "int_of_integer (integer_of_int x) = x" by simp

lemma int_of_integer_shift: "int_of_integer (drop_bit k n) = (int_of_integer n) div (2 ^ k)"
  by transfer (simp add: int_of_integer_pow shiftr_integer_conv_div_pow2)

context
  includes bit_operations_syntax
begin

function power_p_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer" where
  "power_p_integer x n = (if n \<le> 0 then 1 else
    let rec = power_p_integer (mult_p_integer x x) (drop_bit 1 n) in
    if n AND 1 = 0 then rec else mult_p_integer rec x)"
  by pat_completeness auto

termination
proof -
  {
    fix n :: integer
    assume "\<not> (n \<le> 0)"
    hence "n > 0" by auto
    hence "int_of_integer n > 0"
      by (simp add: less_integer.rep_eq)
    hence "0 < int_of_integer n" "int_of_integer n div 2 < int_of_integer n" by auto
  } note * = this
  show ?thesis
    by (relation "measure (\<lambda> (x,n). nat (int_of_integer n))", auto simp: * int_of_integer_shift)
qed

end

text \<open>In experiments with Berlekamp-factorization (where the prime $p$ is usually small),
  it turned out that taking the below implementation of inverse via exponentiation
  is faster than the one based on the extended Euclidean algorithm.\<close>

definition inverse_p_integer :: "integer \<Rightarrow> integer" where
  "inverse_p_integer x = (if x = 0 then 0 else power_p_integer x (p - 2))"

definition divide_p_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"  where
  "divide_p_integer x y = mult_p_integer x (inverse_p_integer y)"

definition finite_field_ops_integer :: "integer arith_ops_record" where
  "finite_field_ops_integer \<equiv> Arith_Ops_Record
      0
      1
      plus_p_integer
      mult_p_integer
      minus_p_integer
      uminus_p_integer
      divide_p_integer
      inverse_p_integer
      (\<lambda> x y . if y = 0 then x else 0)
      (\<lambda> x . if x = 0 then 0 else 1)
      (\<lambda> x . x)
      integer_of_int
      int_of_integer
      (\<lambda> x. 0 \<le> x \<and> x < p)"
end

lemma shiftr_integer_code [code_unfold]: "drop_bit 1 x = (integer_shiftr x 1)"
  unfolding shiftr_integer_code using integer_of_nat_1 by auto

text \<open>For soundness of the integer implementation, we mainly prove that this implementation
  implements the int-based implementation of GF(p).\<close>
context mod_ring_locale
begin

context fixes pp :: "integer"
  assumes ppp: "p = int_of_integer pp"
begin

lemmas integer_simps =
  int_of_integer_0
  int_of_integer_plus
  int_of_integer_minus
  int_of_integer_mult

definition urel_integer :: "integer \<Rightarrow> int \<Rightarrow> bool" where "urel_integer x y = (y = int_of_integer x \<and> y \<ge> 0 \<and> y < p)"

definition mod_ring_rel_integer :: "integer \<Rightarrow> 'a mod_ring \<Rightarrow> bool" where
  "mod_ring_rel_integer x y = (\<exists> z. urel_integer x z \<and> mod_ring_rel z y)"

lemma urel_integer_0: "urel_integer 0 0" unfolding urel_integer_def using p2 by simp

lemma urel_integer_1: "urel_integer 1 1" unfolding urel_integer_def using p2 by simp

lemma le_int_of_integer: "(x \<le> y) = (int_of_integer x \<le> int_of_integer y)"
  by (rule less_eq_integer.rep_eq)

lemma urel_integer_plus: assumes "urel_integer x y" "urel_integer x' y'"
  shows "urel_integer (plus_p_integer pp x x') (plus_p p y y')"
proof -
  let ?x = "int_of_integer x"
  let ?x' = "int_of_integer x'"
  let ?p = "int_of_integer pp"
  from assms have id: "y = ?x" "y' = ?x'"
    and rel: "0 \<le> ?x" "?x < p"
      "0 \<le> ?x'" "?x' \<le> p" unfolding urel_integer_def by auto
  have le: "(pp \<le> x + x') = (?p \<le> ?x + ?x')" unfolding le_int_of_integer
    using rel by auto
  show ?thesis
  proof (cases "?p \<le> ?x + ?x'")
    case True
    hence True: "(?p \<le> ?x + ?x') = True" by simp
    show ?thesis unfolding id
      using rel unfolding plus_p_integer_def plus_p_def Let_def urel_integer_def
      unfolding ppp le True if_True
      using True by auto
  next
    case False
    hence False: "(?p \<le> ?x + ?x') = False" by simp
    show ?thesis unfolding id
      using rel unfolding plus_p_integer_def plus_p_def Let_def urel_integer_def
      unfolding ppp le False if_False
      using False by auto
  qed
qed

lemma urel_integer_minus: assumes "urel_integer x y" "urel_integer x' y'"
  shows "urel_integer (minus_p_integer pp x x') (minus_p p y y')"
proof -
  let ?x = "int_of_integer x"
  let ?x' = "int_of_integer x'"
  from assms have id: "y = ?x" "y' = ?x'"
    and rel: "0 \<le> ?x" "?x < p"
      "0 \<le> ?x'" "?x' \<le> p" unfolding urel_integer_def by auto
  have le: "(x' \<le> x) = (?x' \<le> ?x)" unfolding le_int_of_integer
    using rel by auto
  show ?thesis
  proof (cases "?x' \<le> ?x")
    case True
    hence True: "(?x' \<le> ?x) = True" by simp
    show ?thesis unfolding id
      using rel unfolding minus_p_integer_def minus_p_def Let_def urel_integer_def
      unfolding ppp le True if_True
      using True by auto
  next
    case False
    hence False: "(?x' \<le> ?x) = False" by simp
    show ?thesis unfolding id
      using rel unfolding minus_p_integer_def minus_p_def Let_def urel_integer_def
      unfolding ppp le False if_False
      using False by auto
  qed
qed

lemma urel_integer_uminus: assumes "urel_integer x y"
  shows "urel_integer (uminus_p_integer pp x) (uminus_p p y)"
proof -
  let ?x = "int_of_integer x"
  from assms have id: "y = ?x"
    and rel: "0 \<le> ?x" "?x < p"
      unfolding urel_integer_def by auto
  have le: "(x = 0) = (?x = 0)" unfolding int_of_integer_0_iff
    using rel by auto
  show ?thesis
  proof (cases "?x = 0")
    case True
    hence True: "(?x = 0) = True" by simp
    show ?thesis unfolding id
      using rel unfolding uminus_p_integer_def uminus_p_def Let_def urel_integer_def
      unfolding ppp le True if_True
      using True by auto
  next
    case False
    hence False: "(?x = 0) = False" by simp
    show ?thesis unfolding id
      using rel unfolding uminus_p_integer_def uminus_p_def Let_def urel_integer_def
      unfolding ppp le False if_False
      using False by auto
  qed
qed

lemma pp_pos: "int_of_integer pp > 0"
  using ppp nontriv[where 'a = 'a]  unfolding p
  by (simp add: less_integer.rep_eq)

lemma urel_integer_eq: assumes "urel_integer x y" "urel_integer x' y'"
  shows "(x = x') = (y = y')"
proof -
  let ?x = "int_of_integer x"
  let ?x' = "int_of_integer x'"
  from assms have id: "y = ?x" "y' = ?x'"
    unfolding urel_integer_def by auto
  show ?thesis unfolding id integer_eq_iff ..
qed

lemma urel_integer_normalize:
assumes x: "urel_integer x y"
shows "urel_integer (if x = 0 then 0 else 1) (if y = 0 then 0 else 1)"
 unfolding urel_integer_eq[OF x urel_integer_0] using urel_integer_0 urel_integer_1 by auto

lemma urel_integer_mod:
assumes x: "urel_integer x x'" and y: "urel_integer y y'"
shows "urel_integer (if y = 0 then x else 0) (if y' = 0 then x' else 0)"
  unfolding urel_integer_eq[OF y urel_integer_0] using urel_integer_0 x by auto

lemma urel_integer_power: "urel_integer x x' \<Longrightarrow> urel_integer y (int y') \<Longrightarrow> urel_integer (power_p_integer pp x y) (power_p p x' y')"
including bit_operations_syntax proof (induct x' y' arbitrary: x y rule: power_p.induct[of _ p])
  case (1 x' y' x y)
  note x = 1(2) note y = 1(3)
  show ?case
  proof (cases "y' \<le> 0")
    case True
    hence y: "y = 0" "y' = 0" using urel_integer_eq[OF y urel_integer_0] by auto
    show ?thesis unfolding y True by (simp add: power_p.simps urel_integer_1)
  next
    case False
    hence id: "(y \<le> 0) = False" "(y' = 0) = False" using False y
      by (auto simp add: urel_integer_def not_le) (metis of_int_integer_of of_int_of_nat_eq of_nat_0_less_iff)
    obtain d' r' where dr': "Euclidean_Rings.divmod_nat y' 2 = (d',r')" by force
    from Euclidean_Rings.divmod_nat_def[of y' 2, unfolded dr']
    have r': "r' = y' mod 2" and d': "d' = y' div 2" by auto
    have aux: "\<And> y'. int (y' mod 2) = int y' mod 2" by presburger
    have "urel_integer (y AND 1) r'" unfolding r' using y unfolding urel_integer_def
      unfolding ppp
      apply (auto simp add: and_one_eq)
      apply (simp add: of_nat_mod)
      done
    from urel_integer_eq[OF this urel_integer_0]
    have rem: "(y AND 1 = 0) = (r' = 0)" by simp
    have div: "urel_integer (drop_bit 1 y) (int d')" unfolding d' using y unfolding urel_integer_def
      unfolding ppp shiftr_integer_conv_div_pow2 by auto
    from id have "y' \<noteq> 0" by auto
    note IH = 1(1)[OF this refl dr'[symmetric] urel_integer_mult[OF x x] div]
    show ?thesis unfolding power_p.simps[of _ _ "y'"] power_p_integer.simps[of _ _ y] dr' id if_False rem
      using IH urel_integer_mult[OF IH x] by (auto simp: Let_def)
  qed
qed

lemma urel_integer_inverse: assumes x: "urel_integer x x'"
  shows "urel_integer (inverse_p_integer pp x) (inverse_p p x')"
proof -
  have p: "urel_integer (pp - 2) (int (nat (p - 2)))" using p2 unfolding urel_integer_def unfolding ppp
    by auto
  show ?thesis
    unfolding inverse_p_integer_def inverse_p_def urel_integer_eq[OF x urel_integer_0] using urel_integer_0 urel_integer_power[OF x p]
    by auto
qed

lemma mod_ring_0__integer: "mod_ring_rel_integer 0 0"
  using urel_integer_0 mod_ring_0 unfolding mod_ring_rel_integer_def by blast

lemma mod_ring_1__integer: "mod_ring_rel_integer 1 1"
  using urel_integer_1 mod_ring_1 unfolding mod_ring_rel_integer_def by blast

lemma mod_ring_uminus_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer) (uminus_p_integer pp) uminus"
  using urel_integer_uminus mod_ring_uminus unfolding mod_ring_rel_integer_def rel_fun_def by blast

lemma mod_ring_plus_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer ===> mod_ring_rel_integer) (plus_p_integer pp) (+)"
  using urel_integer_plus mod_ring_plus unfolding mod_ring_rel_integer_def rel_fun_def by blast

lemma mod_ring_minus_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer ===> mod_ring_rel_integer) (minus_p_integer pp) (-)"
  using urel_integer_minus mod_ring_minus unfolding mod_ring_rel_integer_def rel_fun_def by blast

lemma mod_ring_mult_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer ===> mod_ring_rel_integer) (mult_p_integer pp) ((*))"
  using urel_integer_mult mod_ring_mult unfolding mod_ring_rel_integer_def rel_fun_def by blast

lemma mod_ring_eq_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer ===> (=)) (=) (=)"
  using urel_integer_eq mod_ring_eq unfolding mod_ring_rel_integer_def rel_fun_def by blast

lemma urel_integer_inj: "urel_integer x y \<Longrightarrow> urel_integer x z \<Longrightarrow> y = z"
  using urel_integer_eq[of x y x z] by auto

lemma urel_integer_inj': "urel_integer x z \<Longrightarrow> urel_integer y z \<Longrightarrow> x = y"
  using urel_integer_eq[of x z y z] by auto

lemma bi_unique_mod_ring_rel_integer:
  "bi_unique mod_ring_rel_integer" "left_unique mod_ring_rel_integer" "right_unique mod_ring_rel_integer"
  using bi_unique_mod_ring_rel urel_integer_inj'
  unfolding mod_ring_rel_integer_def bi_unique_def left_unique_def right_unique_def
  by (auto simp: urel_integer_def)

lemma right_total_mod_ring_rel_integer: "right_total mod_ring_rel_integer"
  unfolding mod_ring_rel_integer_def right_total_def
proof
  fix y :: "'a mod_ring"
  from right_total_mod_ring_rel[unfolded right_total_def, rule_format, of y]
  obtain z where zy: "mod_ring_rel z y" by auto
  hence zp: "0 \<le> z" "z < p" unfolding mod_ring_rel_def p using range_to_int_mod_ring[where 'a = 'a] by auto
  hence "urel_integer (integer_of_int z) z" unfolding urel_integer_def unfolding ppp
    by auto
  with zy show "\<exists> x z. urel_integer x z \<and> mod_ring_rel z y" by blast
qed

lemma Domainp_mod_ring_rel_integer: "Domainp mod_ring_rel_integer = (\<lambda>x. 0 \<le> x \<and> x < pp)"
proof
  fix x
  show "Domainp mod_ring_rel_integer x = (0 \<le> x \<and> x < pp)"
    unfolding Domainp.simps
    unfolding mod_ring_rel_integer_def
  proof
    let ?i = "int_of_integer"
    assume *: "0 \<le> x \<and> x < pp"
    hence "0 \<le> ?i x \<and> ?i x < p" unfolding ppp
      by (simp add: le_int_of_integer less_integer.rep_eq)
    hence "?i x \<in> {0 ..< p}" by auto
    with Domainp_mod_ring_rel
    have "Domainp mod_ring_rel (?i x)" by auto
    from this[unfolded Domainp.simps]
    obtain b where b: "mod_ring_rel (?i x) b" by auto
    show "\<exists>a b. x = a \<and> (\<exists>z. urel_integer a z \<and> mod_ring_rel z b)"
    proof (intro exI, rule conjI[OF refl], rule exI, rule conjI[OF _ b])
      show "urel_integer x (?i x)" unfolding urel_integer_def using * unfolding ppp
        by (simp add: le_int_of_integer less_integer.rep_eq)
    qed
  next
    assume "\<exists>a b. x = a \<and> (\<exists>z. urel_integer a z \<and> mod_ring_rel z b)"
    then obtain b z where xz: "urel_integer x z" and zb: "mod_ring_rel z b" by auto
    hence "Domainp mod_ring_rel z"  by auto
    with Domainp_mod_ring_rel have "0 \<le> z" "z < p" by auto
    with xz show "0 \<le> x \<and> x < pp" unfolding urel_integer_def unfolding ppp
      by (simp add: le_int_of_integer less_integer.rep_eq)
  qed
qed

lemma ring_finite_field_ops_integer: "ring_ops (finite_field_ops_integer pp) mod_ring_rel_integer"
  by (unfold_locales, auto simp:
  finite_field_ops_integer_def
  bi_unique_mod_ring_rel_integer
  right_total_mod_ring_rel_integer
  mod_ring_plus_integer
  mod_ring_minus_integer
  mod_ring_uminus_integer
  mod_ring_mult_integer
  mod_ring_eq_integer
  mod_ring_0__integer
  mod_ring_1__integer
  Domainp_mod_ring_rel_integer)
end
end

context prime_field
begin
context fixes pp :: "integer"
  assumes *: "p = int_of_integer pp"
begin

lemma mod_ring_normalize_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer) (\<lambda>x. if x = 0 then 0 else 1) normalize"
  using urel_integer_normalize[OF *] mod_ring_normalize unfolding mod_ring_rel_integer_def[OF *] rel_fun_def by blast

lemma mod_ring_mod_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer ===> mod_ring_rel_integer) (\<lambda>x y. if y = 0 then x else 0) (mod)"
  using urel_integer_mod[OF *] mod_ring_mod unfolding mod_ring_rel_integer_def[OF *] rel_fun_def by blast

lemma mod_ring_unit_factor_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer) (\<lambda>x. x) unit_factor"
  using mod_ring_unit_factor unfolding mod_ring_rel_integer_def[OF *] rel_fun_def by blast

lemma mod_ring_inverse_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer) (inverse_p_integer pp) inverse"
  using urel_integer_inverse[OF *] mod_ring_inverse unfolding mod_ring_rel_integer_def[OF *] rel_fun_def by blast

lemma mod_ring_divide_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer ===> mod_ring_rel_integer) (divide_p_integer pp) (/)"
  using mod_ring_inverse_integer mod_ring_mult_integer[OF *]
  unfolding divide_p_integer_def divide_mod_ring_def inverse_mod_ring_def[symmetric]
    rel_fun_def by blast

lemma finite_field_ops_integer: "field_ops (finite_field_ops_integer pp) mod_ring_rel_integer"
  by (unfold_locales, insert ring_finite_field_ops_integer[OF *], auto simp:
  ring_ops_def
  finite_field_ops_integer_def
  mod_ring_divide_integer
  mod_ring_inverse_integer
  mod_ring_mod_integer
  mod_ring_normalize_integer)
end
end

context prime_field
begin
 (* four implementations of modular integer arithmetic for finite fields *)
thm
  finite_field_ops64
  finite_field_ops32
  finite_field_ops_integer
  finite_field_ops_int
end

context mod_ring_locale
begin
 (* four implementations of modular integer arithmetic for finite rings *)
thm
  ring_finite_field_ops64
  ring_finite_field_ops32
  ring_finite_field_ops_integer
  ring_finite_field_ops_int
end

end


theory VCTheoryLemmas
  imports VCTheory
begin

lemma substate_refl: "substate s s"
  apply(cases s)
         apply(auto)
  done

lemma substate_trans:
"substate s1 s2 \<Longrightarrow> substate s2 s3 \<Longrightarrow> substate s1 s3"
  apply((induction s3); (simp split: if_splits))
  done

lemma substate_antisym:
 "substate s1 s2 \<Longrightarrow> substate s2 s1 \<Longrightarrow> s1=s2"
  apply((induction s2 arbitrary: s1); (metis substate.simps substate_refl substate_trans))
  done

lemma predEnv_substate: "substate (predEnv s) s"
  apply(induction s)
  using substate_refl  by auto

lemma substate_imp_substatete_predEnv_or_eq:
"substate s1 s2 \<and> toEnvP s1 \<Longrightarrow> substate s1 (predEnv s2) \<or> s1=s2"
  apply((induction s2); (simp split: if_splits))
          apply auto
  done

lemma substate_linear:
"substate s1 s \<and> substate s2 s \<longrightarrow>
 substate s1 s2 \<or> substate s2 s1"
  apply(induction s)
         apply(auto)
  done

lemma toEnvNum_id: "toEnvNum s s = 0"
  apply(cases s)
         apply(auto)
  done

lemma substate_toEnvNum_id:
"substate s1 s2 \<and> toEnvNum s1 s2 = 0 \<and> toEnvP s1 \<and>
toEnvP s2 \<longrightarrow> s1=s2"
  apply(cases s2)
         apply(auto)
  done

lemma predEnvPI: "\<not> toEnvP s \<and>
toEnvNum emptyState s > 0 \<longrightarrow>
toEnvP (predEnv s)"
  apply(induction s)
         apply(auto)
  done

lemma predEnvP: "toEnvNum emptyState s > 1 \<Longrightarrow>
toEnvP (predEnv s)"
  apply(induction s)
  using predEnvPI apply auto
  done

lemma toEnvP_substate_pred_imp_toEnvP_pred:
"toEnvP s1 \<and> substate s1 (predEnv s2) \<Longrightarrow> toEnvP (predEnv s2)"
  apply(induction s2)
            apply auto
  by (simp split: if_splits)

lemma gtime_predI:
 "\<not> toEnvP s \<Longrightarrow>   toEnvNum emptyState s =
 toEnvNum emptyState (predEnv s)"
  apply(induction s)
         apply(auto)
  done

lemma gtime_pred:
"toEnvP s \<longrightarrow> toEnvNum emptyState s =
toEnvNum emptyState (predEnv s) + 1"
  apply(induction s)
  using gtime_predI apply auto
  done

lemma shift_spec:
 "toEnvP s \<and> toEnvNum emptyState s > n \<Longrightarrow>
toEnvP (shift s n) \<and>
 toEnvNum emptyState (shift s n) =
 toEnvNum emptyState s - n"
  apply(induction n)
  using predEnvP apply auto
  using gtime_pred predEnvP
  by (metis Suc_eq_plus1 diff_Suc_1 diff_diff_eq)

lemma toEnvNum3: "substate s1 s2 \<and> substate s2 s3
 \<Longrightarrow> toEnvNum s1 s3 = toEnvNum s1 s2 + toEnvNum s2 s3"
  apply((induction s3); (simp split: if_splits); (meson substate.simps substate_antisym))
  done

lemma emptyState_substate: "substate emptyState s"
  apply(induction s)
         apply(auto)
  done

lemma toEnvNum_substate1: "substate s1 s2 \<and> substate s2 s3 \<Longrightarrow> toEnvNum s1 s2 \<le> toEnvNum s1 s3"
  using toEnvNum3 apply auto
  done

lemma toEnvNum_substate2: "substate s1 s2 \<and> substate s2 s3 \<Longrightarrow> toEnvNum s2 s3 \<le> toEnvNum s1 s3"
  using toEnvNum3 apply auto
  done

lemma toEnvNum_eq_imp_eq1: "substate s1 s2 \<and> substate s1 s3 \<and> substate s2 s4 \<and> substate s3 s4 \<and> toEnvP s2 \<and> toEnvP s3 \<and>
toEnvNum s1 s2 = toEnvNum s1 s3 \<longrightarrow> s2=s3"
  using substate_linear toEnvNum3 substate_toEnvNum_id
  by (metis add_eq_self_zero)

lemma toEnvNum_eq_imp_eq2: "substate s1 s3 \<and> substate s2 s3 \<and> toEnvP s1 \<and> toEnvP s2 \<and> toEnvNum s1 s3 = toEnvNum s2 s3 \<longrightarrow>
s1=s2"
  using substate_linear toEnvNum3 substate_toEnvNum_id
  by (metis add_cancel_left_left)

lemma shift_substate: "substate (shift s n) s"
  apply(induction n)
  using substate_refl apply auto
  using predEnv_substate substate_trans apply blast
  done

lemma toEnvNum_shift: "toEnvP s \<and>
toEnvNum emptyState s > n
  \<Longrightarrow> toEnvNum (shift s n) s = n"
  using shift_spec toEnvNum3 emptyState_substate
  by (metis add.right_neutral add_diff_inverse_nat diff_add_inverse diff_add_inverse2 diff_less_mono2 nat_diff_split not_gr_zero shift_substate)

lemma substate_shift:
"toEnvP s1 \<and> toEnvP s \<and> substate s1 s \<and>
toEnvNum s1 s \<ge> n \<Longrightarrow>
substate s1 (shift s n)"
  apply(induction n)
   apply auto
  using toEnvNum_shift
  by (metis diff_Suc_Suc diff_diff_cancel emptyState_substate less_imp_diff_less not_less_eq_eq substate_imp_substatete_predEnv_or_eq toEnvNum_substate2 verit_comp_simplify1(3))

lemma predEnv_toEnvP_or_emptyState:
"toEnvP (predEnv s) \<or> predEnv s = emptyState"
  apply(induction s)
         apply(auto)
  done

lemma shiftEnvP_or_emptyState: "n \<noteq> 0 \<longrightarrow>
 toEnvP (shift s n) \<or> shift s n = emptyState"
  apply(cases n)
  using predEnv_toEnvP_or_emptyState by auto

lemma shift_toEnvNum:
"toEnvP s \<and> toEnvP s1 \<and> substate s1 s \<Longrightarrow>
shift s (toEnvNum s1 s) = s1"
  apply(rule cut_rl[of "substate s1 (shift s (toEnvNum s1 s))"])
   apply(rule cut_rl[of "toEnvNum emptyState s1 > 0"])
  apply (smt (verit, del_insts) add_cancel_right_left emptyState_substate less_add_same_cancel2 linorder_not_less shift.simps(1) shiftEnvP_or_emptyState shift_substate substate_toEnvNum_id toEnvNum3 toEnvNum_shift toEnvNum_substate2)
   apply((cases s1);simp)
  using substate_shift apply auto
  done

lemma ltime_le_toEnvNum:
"ltime s p \<le> toEnvNum emptyState s"
  apply(induction s)
         apply(auto)
  done

lemma predEnv_substate_imp_substate_or_eq:
"toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s \<and>
 substate s2 s \<and> substate (predEnv s1) s2 \<longrightarrow>
 substate s1 s2 \<or> s2 = predEnv s1"
  using substate_antisym substate_imp_substatete_predEnv_or_eq substate_linear by blast

lemma state_ind:
"toEnvP s \<and> toEnvP s1 \<Longrightarrow> P s \<Longrightarrow>
 (\<And> s2. toEnvP s2 \<Longrightarrow>
 (substate s1 s2 \<and> substate s2 s \<and> s1 \<noteq> s2)
 \<Longrightarrow> P s2 \<Longrightarrow> P (predEnv s2)) \<Longrightarrow>
toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s \<longrightarrow>
 P s2"
proof -
  assume 1: "toEnvP s \<and> toEnvP s1"
  define Q:: "nat \<Rightarrow> bool" where
"Q = (\<lambda> n. P (shift s n))"
  from Q_def  1 shift_toEnvNum have P_def:
"\<And> s'. toEnvP s' \<and> substate s' s \<Longrightarrow>
P s' = Q (toEnvNum s' s)" by auto
  define n where "n = toEnvNum s2 s"
  assume base: "P s" and ind_step:
"\<And> s2. toEnvP s2 \<Longrightarrow>
 (substate s1 s2 \<and> substate s2 s \<and> s1 \<noteq> s2)
 \<Longrightarrow> P s2 \<Longrightarrow> P (predEnv s2)"
  show ?thesis
  proof
    assume 2: "toEnvP s2 \<and> substate s1 s2 \<and>
 substate s2 s"
    with 1  n_def shift_toEnvNum have s2_def: "s2 = shift s n"
      by auto
     from 2 show "P s2"
      apply(simp only: P_def n_def[symmetric])
      apply(simp only: s2_def)
    proof(induction n)
      case 0
      then show ?case using Q_def base by auto
    next
      case (Suc n)
      then show ?case
        apply(simp only: Q_def)
        print_state
      proof cases
        assume 3: "s1 = shift s n"
        assume 4: "toEnvP (shift s (Suc n)) \<and>
    substate s1 (shift s (Suc n)) \<and>
    substate (shift s (Suc n)) s"
        from 3 have 5: "substate (shift s n) s1"
          using substate_refl by auto
        from predEnv_substate have
"substate (shift s (Suc n)) (shift s n)"
          by simp
        with 4 5  substate_antisym substate_trans
        have "s1 = shift s (Suc n)"
          by blast
        with 3 have
 "shift s n = shift s (Suc n)" by simp
        with 4 gtime_pred show
 "P (shift s (Suc n))" by fastforce
      next
        assume 3: "s1 \<noteq> shift s n"
        assume 4: "toEnvP (shift s (Suc n)) \<and>
    substate s1 (shift s (Suc n)) \<and>
    substate (shift s (Suc n)) s"
from predEnv_substate have
"substate (shift s (Suc n)) (shift s n)"
  by simp
  with 4 substate_trans have 5:
 "substate s1 (shift s n)" by blast
  have 6: "toEnvP (shift s n)"
  proof cases
    assume "n = 0"
    with 1 show ?thesis by auto
  next
    assume "n \<noteq> 0"
    with shiftEnvP_or_emptyState have
"toEnvP (shift s n) \<or>
 (shift s n) =  emptyState" by auto
    thus ?thesis
    proof
      assume "toEnvP (shift s n)"
      thus ?thesis by assumption
    next
      assume "shift s n = emptyState"
      with 5 have "s1 = emptyState"
        by (cases s1; auto)
      with 1 show ?thesis by auto
    qed
  qed
  assume "(toEnvP (shift s n) \<and>
     substate s1 (shift s n) \<and>
     substate (shift s n) s \<Longrightarrow>
     P (shift s n))"
  with 3 5 6 shift_substate ind_step
  show "P (shift s (Suc n))"
    by auto
qed
qed
qed
qed

end


(*<*) theory ex4_2 imports Main begin (*>*)

text {* In this exercise, we will prove some lemmas of propositional
logic with the aid of a calculus of natural deduction.

For the proofs, you may only use

\begin{itemize}
\item the following lemmas: \\
@{text "notI:"}~@{thm notI[of A,no_vars]},\\
@{text "notE:"}~@{thm notE[of A B,no_vars]},\\
@{text "conjI:"}~@{thm conjI[of A B,no_vars]},\\
@{text "conjE:"}~@{thm conjE[of A B C,no_vars]},\\
@{text "disjI1:"}~@{thm disjI1[of A B,no_vars]},\\
@{text "disjI2:"}~@{thm disjI2[of A B,no_vars]},\\
@{text "disjE:"}~@{thm disjE[of A B C,no_vars]},\\
@{text "impI:"}~@{thm impI[of A B,no_vars]},\\
@{text "impE:"}~@{thm impE[of A B C,no_vars]},\\
@{text "mp:"}~@{thm mp[of A B,no_vars]}\\
@{text "iffI:"}~@{thm iffI[of A B,no_vars]}, \\
@{text "iffE:"}~@{thm iffE[of A B C,no_vars]}\\
@{text "classical:"}~@{thm classical[of A,no_vars]}

\item the proof methods @{term rule}, @{term erule} and @{term assumption}.
\end{itemize}

Prove:
*}

lemma I: "A \<longrightarrow> A"
  apply (rule impI)
  done

lemma "A \<and> B \<longrightarrow> B \<and> A"
  apply(rule impI)
  apply(rule conjE)
  apply assumption
   apply (rule conjI)
    apply assumption
  apply assumption
  done

lemma "(A \<and> B) \<longrightarrow> (A \<or> B)"
  apply (rule impI)
  apply (rule disjI1)
  apply (erule conjE)
  apply assumption
  done

lemma "((A \<or> B) \<or> C) \<longrightarrow> A \<or> (B \<or> C)"
  apply (rule impI)
  apply (erule disjE)
   apply(erule disjE)
    apply(erule disjI1)+
   apply (rule disjI2)
   apply (erule disjI1)
  apply (rule disjI2)+
  apply (assumption)
  done

lemma "(A \<or> A) = (A \<and> A)"
  apply(rule iffI)
   apply (rule conjI)
    apply (erule disjE)
     apply assumption+
apply (erule disjE)
    apply assumption+
  apply (erule conjE)
  apply (rule disjI1)
  apply assumption
  done

lemma S: "(A \<longrightarrow> B \<longrightarrow> C) \<longrightarrow> (A \<longrightarrow> B) \<longrightarrow> A \<longrightarrow> C"
  apply (rule impI)+
  apply (erule impE)
   apply assumption
  apply (erule impE)
   apply assumption
  apply (erule mp)
  apply assumption
  done

lemma "(A \<longrightarrow> B) \<longrightarrow> (B \<longrightarrow> C) \<longrightarrow> A \<longrightarrow> C"
  apply (rule impI)+
  apply (erule impE)
   apply assumption
  apply (erule mp)
  apply assumption

lemma "\<not> \<not> A \<longrightarrow> A"
  apply (rule impI)
  apply (rule classical)
  apply (erule notE)
  apply assumption
  done

lemma "A \<longrightarrow> \<not> \<not> A"
  apply (rule impI)
  apply (rule notI)
  apply (erule notE)
  apply assumption
  done

lemma "(\<not> A \<longrightarrow> B) \<longrightarrow> (\<not> B \<longrightarrow> A)"

  apply (rule impI)+
  apply (rule classical)
  apply (erule impE)
   apply assumption
  apply (erule notE)
  apply assumption
  done

lemma "((A \<longrightarrow> B) \<longrightarrow> A) \<longrightarrow> A"
  apply (rule impI)+
  apply (rule classical)
  apply (erule impE)
   apply (rule impI)
   apply (erule notE)
   apply assumption
  apply assumption
  done

lemma "A \<or> \<not> A"
  apply (rule classical)
  apply (rule disjI2)
  apply (rule notI)
  apply (erule notE)
  apply (rule disjI1)
  apply assumption
  done

lemma "(\<not> (A \<and> B)) = (\<not> A \<or> \<not> B)"
  apply (rule iffI)
   apply (rule classical)
   apply (erule notE)
   apply (rule conjI)
    apply (rule classical)
    apply (erule notE)
    apply (rule disjI1)
    apply assumption
   apply (rule classical)
   apply (erule notE)
  apply (rule disjI2)
  apply assumption

  apply (rule notI)
  apply (erule conjE)
  apply (erule disjE)
  apply (erule notE,  assumption)+
  done

(*<*) end (*>*)


theory prop_25
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin
  datatype 'a list = Nil2 | Cons2 "'a" "'a list"
  datatype Nat = Z | S "Nat"
  fun plus :: "Nat => Nat => Nat" where
  "plus (Z) y = y"
  | "plus (S z) y = S (plus z y)"
  fun length :: "'a list => Nat" where
  "length (Nil2) = Z"
  | "length (Cons2 y xs) = S (length xs)"
  fun even :: "Nat => bool" where
  "even (Z) = True"
  | "even (S (Z)) = False"
  | "even (S (S z)) = even z"
  fun append :: "'a list => 'a list => 'a list" where
  "append (Nil2) y = y"
  | "append (Cons2 z xs) y = Cons2 z (append xs y)"
  (*hipster plus length even append *)

lemma lemma_a [thy_expl]: "plus x2 Z = x2"
by (hipster_induct_schemes plus.simps)

lemma lemma_aa [thy_expl]: "plus (plus x2 y2) z2 = plus x2 (plus y2 z2)"
by (hipster_induct_schemes plus.simps)

lemma lemma_ab [thy_expl]: "plus x2 (S y2) = S (plus x2 y2)"
by (hipster_induct_schemes plus.simps)

lemma lemma_ac [thy_expl]: "plus x1 (plus y1 x1) = plus y1 (plus x1 x1)"
by (hipster_induct_schemes plus.simps)

lemma lemma_ad [thy_expl]: "plus x2 (plus y2 y2) = plus y2 (plus y2 x2)"
by (hipster_induct_schemes plus.simps)

lemma lemma_ae [thy_expl]: "plus x2 (S y2) = S (plus y2 x2)"
by (hipster_induct_schemes plus.simps)

lemma lemma_af [thy_expl]: "plus (S x2) y2 = S (plus y2 x2)"
by (hipster_induct_schemes plus.simps)

lemma lemma_ag [thy_expl]: "plus (plus x2 y2) (plus x2 z2) =
plus (plus x2 z2) (plus x2 y2)"
by (hipster_induct_schemes plus.simps)

lemma lemma_ah [thy_expl]: "plus (plus x2 y2) (plus z2 x2) = plus (plus z2 x2) (plus x2 y2)"
by (hipster_induct_schemes plus.simps)

lemma lemma_ai [thy_expl]: "plus x2 (plus y2 z2) = plus y2 (plus z2 x2)"
by (hipster_induct_schemes plus.simps)

(*hipster even plus*)
lemma lemma_aj []: "even (plus x1 x1) = True"
by (hipster_induct_schemes even.simps plus.simps)

(*hipster plus length even append*)
lemma lemma_ak []: "append x2 Nil2 = x2"
by (hipster_induct_schemes plus.simps length.simps even.simps append.simps)

lemma lemma_al []: "append (append x1 y1) z1 = append x1 (append y1 z1)"
by (hipster_induct_schemes plus.simps length.simps even.simps append.simps)

lemma lemma_am [thy_expl]: "plus (length x2) (length y2) = length (append x2 y2)"
by (hipster_induct_schemes plus.simps length.simps even.simps append.simps)

  theorem x0 :
    "(even (length (append x y))) =
       (even (plus (length y) (length x)))"
    by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)
end


theory K_L_Spark_User
imports K_L_Spark_Specification K_L_Spark_Declaration

begin

lemma goal6'1:
  fixes j::int
  assumes H1: "0 <= j"
  assumes H2: "j <= 15"
  shows "0 = k_l' j"
  using assms by (simp add: K_def)

lemma goal7'1:
  fixes j::int
  assumes H1: "16 <= j"
  assumes H2: "j <= 31"
  shows "1518500249 = k_l' j"
proof -
  from H1 have "16 <= nat j" by simp
  moreover from H2 have "nat j <= 31" by simp
  ultimately show ?thesis by (simp add: K_def)
qed

lemma goal8'1:
  assumes H1: " (32 :: int) <= j'' "
  assumes H2: " j'' <= (47 :: int) "
  shows " (1859775393 :: int) = k_l' j'' "
proof -
  from H1 have "32 <= nat j''" by simp
  moreover from H2 have "nat j'' <= 47" by simp
  ultimately show ?thesis by (simp add: K_def)
qed

lemma goal9'1:
  assumes H1: " (48 :: int) <= j'' "
  assumes H2: " j'' <= (63 :: int) "
  shows " (2400959708 :: int) = k_l' j'' " (is "?C1")
proof -
  from H1 have "48 <= nat j''" by simp
  moreover from H2 have "nat j'' <= 63" by simp
  ultimately show ?thesis by (simp add: K_def)
qed

lemma goal10'1:
  assumes H2: " j'' <= (79 :: int) "
  assumes H6: " (63 :: int) < j'' "
  shows " (2840853838 :: int) = k_l' j'' " (is "?C1")
proof -
  from H6 have "64 <= nat j''" by simp
  moreover from H2 have "nat j'' <= 79" by simp
  ultimately show ?thesis by (simp add: K_def)
qed

lemmas userlemmas =
  goal6'1
  goal7'1
  goal8'1
  goal9'1
  goal10'1
end