Theory Z_mod_power_of_2_TM

theory "Z_mod_power_of_2_TM"
  imports Z_mod_power_of_2 "Karatsuba.Nat_LSBF_TM"
begin

definition ensure_length_tm :: "nat  nat_lsbf  nat_lsbf tm" where
"ensure_length_tm k xs =1 fill_tm k xs  take_tm k"

lemma val_ensure_length_tm[simp, val_simp]: "val (ensure_length_tm k xs) = ensure_length k xs"
  unfolding ensure_length_tm_def ensure_length_def by simp

lemma time_ensure_length_tm[simp]: "time (ensure_length_tm k xs) = 7 + 2 * length xs + 2 * k"
  unfolding ensure_length_tm_def tm_time_simps val_fill_tm time_fill_tm time_take_tm
  length_fill'
  using add_min_max[of k "length xs"] by simp

context int_lsbf_mod
begin

definition reduce_tm :: "nat_lsbf  nat_lsbf tm" where
"reduce_tm xs =1 ensure_length_tm k xs"

lemma val_reduce_tm[simp, val_simp]: "val (reduce_tm xs) = reduce xs"
  unfolding reduce_tm_def reduce_def by simp

lemma time_reduce_tm[simp]: "time (reduce_tm xs) = 8 + 2 * length xs + 2 * k"
  unfolding reduce_tm_def by simp

definition add_mod_tm :: "nat_lsbf  nat_lsbf  nat_lsbf tm" where
"add_mod_tm xs ys =1 xs +nt ys  reduce_tm"

lemma val_add_mod_tm[simp, val_simp]: "val (add_mod_tm xs ys) = add_mod xs ys"
  unfolding add_mod_tm_def add_mod_def by simp

lemma time_add_mod_tm_le: "time (add_mod_tm xs ys)  14 + 4 * max (length xs) (length ys) + 2 * k"
  unfolding add_mod_tm_def tm_time_simps val_add_nat_tm time_reduce_tm
  apply (estimation estimate: time_add_nat_tm_le)
  apply (estimation estimate: length_add_nat_upper)
  by simp

definition subtract_mod_tm :: "nat_lsbf  nat_lsbf  nat_lsbf tm" where
"subtract_mod_tm xs ys =1 do {
  b  xs nt ys;
  if b then do {
    fillx  fill_tm k xs;
    fillx1  fillx @t [True];
    fillx1 -nt ys  reduce_tm
  } else xs -nt ys
}"

lemma val_subtract_mod_tm[simp, val_simp]: "val (subtract_mod_tm xs ys) = subtract_mod xs ys"
  unfolding subtract_mod_tm_def subtract_mod_def by simp

lemma time_subtract_mod_tm_le: "time (subtract_mod_tm xs ys)  118 + 51 * max k (max (length xs) (length ys))"
proof -
  define m where "m = max k (max (length xs) (length ys))"
  have 1: "max (length (fill k xs @ [True])) (length ys)  m + 1"
    unfolding length_append length_fill' m_def by (auto simp add: max.assoc)
  have "time (subtract_mod_tm xs ys) = time (xs nt ys) +
    (if xs n ys
     then time (fill_tm k xs) +
          time ((fill k xs) @t [True]) +
          time ((fill k xs @ [True]) -nt ys) +
          time (reduce_tm ((fill k xs @ [True]) -n ys))
     else time (xs -nt ys)) + 1"
    (is "?t = _ + (if ?b then ?c else ?d) + 1")
    unfolding subtract_mod_tm_def tm_time_simps val_compare_nat_tm
  val_fill_tm val_append_tm val_subtract_nat_tm by simp
  moreover have "?c  (2 * length xs + k + 5) +
      (max k (length xs) + 1) +
      (30 * m + 78) +
      (10 + 2 * m + 2 * k)"
    apply (intro add_mono)
    subgoal unfolding time_fill_tm by simp
    subgoal unfolding time_append_tm length_fill' by simp
    subgoal
      apply (estimation estimate: time_subtract_nat_tm_le)
      apply (itrans "30 * (m + 1) + 48")
      subgoal by (intro add_mono mult_le_mono2 order.refl 1)
      subgoal by simp
      done
    subgoal
      unfolding time_reduce_tm
      apply (estimation estimate: conjunct2[OF subtract_nat_aux])
      apply (estimation estimate: 1)
      by simp
    done
  moreover have "?d  30 * m + 78"
    apply (estimation estimate: time_subtract_nat_tm_le)
    unfolding m_def by simp
  ultimately have "?t  time (xs nt ys) +
    ((2 * length xs + k + 5) +
      (max k (length xs) + 1) +
      (30 * m + 78) +
      (10 + 2 * m + 2 * k)) + 1"
    by simp
  also have "...  (13 * m + 23) + ((2 * m + m + 5) + (m + 1) + (30 * m + 78) + (10 + 2 * m + 2 * m)) + 1"
    apply (intro add_mono order.refl)
    subgoal
      apply (estimation estimate: time_compare_nat_tm_le)
      apply (intro add_mono mult_le_mono2 order.refl)
      unfolding m_def by simp
    subgoal unfolding m_def by simp
    subgoal unfolding m_def by simp
    subgoal unfolding m_def by simp
    subgoal unfolding m_def by simp
    done
  also have "... = 118 + 51 * m" by simp
  finally show ?thesis unfolding m_def .
qed

end

end