theory Sepref_Additional
imports Sepref_Basic Sepref_Rules
begin

lemma hoare_alt:
  "<P> c <\<lambda>r. Q r > = (\<forall>h as n.
        pHeap h as n \<Turnstile> P \<longrightarrow> (\<exists>h' t r. execute c h = Some (r, h', t) \<and>
        (pHeap h' (new_addrs h as h') (n - t) \<Turnstile> Q r \<and>
        t \<le> n \<and> relH {a. a < heap.lim h \<and> a \<notin> as} h h' \<and> heap.lim h \<le> heap.lim h')))" (is "?L = (\<forall>h as n. ?H h as n \<longrightarrow> (\<exists>h' t r. _ \<and> ?P h as h' n t r))")
proof -
  have "?L = (\<forall>h as n. pHeap h as n \<Turnstile> P \<longrightarrow>
                  (\<forall> \<sigma> t r. run c (Some h) \<sigma> r t \<longrightarrow> \<sigma> \<noteq> None \<and> (?P h as (the \<sigma>) n t r)))"
    unfolding hoare_triple_def by auto
  also have "\<dots> =  (\<forall>h as n. pHeap h as n \<Turnstile> P \<longrightarrow>
              (\<exists>h' t r. execute c h = Some (r, h', t) \<and>
                         ?P h as h' n t r))" apply(subst run_and_execute) by simp
  finally show ?thesis .
qed

lemma extract_cost_otherway:
  assumes
    "\<Gamma> * timeCredit_assn Cost_lb \<Longrightarrow>\<^sub>A G * F"
    "<G> c <\<lambda>r. Q r >"
    "\<And>r. Q r * F \<Longrightarrow>\<^sub>A \<Gamma>' * (\<exists>\<^sub>Ara. R ra r * \<up>(ra \<in> dom M)) * true"
    "(\<And>c. c\<in>ran M \<Longrightarrow> Cost_lb \<le> c)"
  shows "hn_refine \<Gamma> c \<Gamma>' R (REST M)"
proof -
  note pre_rule[OF assms(1) frame_rule[OF assms(2)]]
  then have TR: "\<And>h as n. pHeap h as n \<Turnstile> \<Gamma> * timeCredit_assn Cost_lb \<Longrightarrow>
           (\<exists>h' t r. execute c h = Some (r, h', t) \<and>
                     pHeap h' (new_addrs h as h') (n - t) \<Turnstile> Q r * F \<and> t \<le> n \<and> relH {a. a < heap.lim h \<and> a \<notin> as} h h' \<and> heap.lim h \<le> heap.lim h')"
    unfolding hoare_alt by simp

  show ?thesis
    unfolding hn_refine_def apply auto
  proof -
    fix h as n
    assume "pHeap h as n \<Turnstile> \<Gamma>"
    then have "pHeap h as (n+Cost_lb) \<Turnstile> \<Gamma> * timeCredit_assn Cost_lb"
      by (simp add: mod_timeCredit_dest)
    from TR[OF this] obtain h' t r where "execute c h = Some (r, h', t)"
           and h: "pHeap h' (new_addrs h as h') (n + Cost_lb - t) \<Turnstile> Q r * F"
           and 3: "t \<le> n + Cost_lb" "relH {a. a < heap.lim h \<and> a \<notin> as} h h'" "heap.lim h \<le> heap.lim h'"
      by blast

    from h assms(3) have h': "pHeap h' (new_addrs h as h') (n + Cost_lb - t) \<Turnstile>   \<Gamma>' * (\<exists>\<^sub>Ara. R ra r * \<up> (ra \<in> dom M)) * true"
      by (simp add: entails_def)
    then have "\<exists>ra. pHeap h' (new_addrs h as h') (n + Cost_lb - t) \<Turnstile>   \<Gamma>' *  R ra r * \<up> (ra \<in> dom M) * true"
      by simp
    then obtain ra where h'': "pHeap h' (new_addrs h as h') (n + Cost_lb - t) \<Turnstile>   \<Gamma>' *  R ra r * \<up> (ra \<in> dom M) * true"
        by blast
    have "pHeap h' (new_addrs h as h') (n + Cost_lb - t) \<Turnstile>   (\<Gamma>' *  R ra r * true) * \<up> (ra \<in> dom M)"
      apply(rule entailsD[OF _ h''])  by (simp add: entails_triv move_back_pure')
    then have h'': "pHeap h' (new_addrs h as h') (n + Cost_lb - t) \<Turnstile>   \<Gamma>' *  R ra r * true" and radom: "ra \<in> dom M"
      using mod_pure_star_dist  by auto

    show "\<exists>h' t r. execute c h = Some (r, h', t) \<and>
                       (\<exists>ra Ca. Some (enat Ca) \<le> M ra \<and> t \<le> n + Ca \<and> pHeap h' (new_addrs h as h') (n + Ca - t) \<Turnstile> \<Gamma>' * R ra r * true) \<and>
                       relH {a. a < heap.lim h \<and> a \<notin> as} h h' \<and> heap.lim h \<le> heap.lim h'"
      apply(rule exI[where x=h']) apply(rule exI[where x=t]) apply(rule exI[where x=r])
      apply safe apply fact
          apply(rule exI[where x=ra])
        apply(rule exI[where x=Cost_lb])
        apply safe
      subgoal using assms(4) radom using ranI by force
      subgoal by fact
      subgoal using h'' mod_star_trueI by blast
       apply fact apply fact done
  qed
qed

lemma extract_cost_otherway':
  fixes R
  assumes
    "\<Gamma> * timeCredit_assn Cost_lb \<Longrightarrow>\<^sub>A G * F"
    "\<And>h. h\<Turnstile>\<Gamma> \<Longrightarrow> <G> c <\<lambda>r. Q r >"
    "\<And>r h. h\<Turnstile>\<Gamma> \<Longrightarrow> Q r * F \<Longrightarrow>\<^sub>A \<Gamma>' * (\<exists>\<^sub>Ara. R ra r * \<up>(ra \<in> dom M)) * true"
    "(\<And>c h. h\<Turnstile>\<Gamma> \<Longrightarrow> c\<in>ran M \<Longrightarrow> Cost_lb \<le> c)"
  shows "hn_refine \<Gamma> c \<Gamma>' R (REST M)"
  apply(rule hn_refine_preI)
  apply(rule extract_cost_otherway)
  using assms by auto

lemmas extr = extract_cost_otherway[where F=emp, simplified, OF ent_refl _ ent_refl]

lemma extr': "(\<And>M. m = SPECT M \<Longrightarrow> <\<Gamma> * timeCredit_assn Cost_lb> c <\<lambda>r. \<exists>\<^sub>Ara. \<Gamma>' * (R ra r * \<up> (ra \<in> dom M)) * true>) \<Longrightarrow>
(\<And>c M. m = SPECT M \<Longrightarrow> c \<in> ran M \<Longrightarrow> enat Cost_lb \<le> c) \<Longrightarrow> hn_refine \<Gamma> c \<Gamma>' R m"
  apply(cases m)
    subgoal by simp
  subgoal premises prems for M
    using extr[OF prems(1)[OF prems(3)] prems(2)[OF prems(3)]]  prems(3) by simp
  done

lemma hfrefb_to_hoare_triple:
   assumes
  "(\<And>M h c a t. P a \<Longrightarrow> D a \<le> t a \<Longrightarrow>  h\<Turnstile>fst RS a c \<Longrightarrow> g t a = SPECT M
       \<Longrightarrow> <fst RS a c * timeCredit_assn (D a)> f c <\<lambda>r. \<exists>\<^sub>Ara. snd RS a c * (T ra r * \<up> (ra \<in> dom M)) * true>)"
  "(\<And>co M h c a t. P a \<Longrightarrow> D a \<le> t a \<Longrightarrow> h\<Turnstile>fst RS a c \<Longrightarrow> g t a = SPECT M \<Longrightarrow> co \<in> ran M
       \<Longrightarrow> enat (D a) \<le> co)"
shows "(f,g)\<in>hfrefb P D RS T"
  apply(rule hfrefbI)
  apply(rule hn_refine_preI)
  subgoal for c a t h
    apply(rule extr'[where Cost_lb="D a"])
     apply (rule assms(1)) apply simp_all
    apply (rule assms(2)) apply simp_all
    done
  done

subsection "how to extract a hoare triple from hn_refine"

lemma extract_cost_ub:
  assumes "hn_refine \<Gamma> c \<Gamma>' R (REST M)" "(\<And>c. c\<in>ran M \<Longrightarrow> c \<le> Cost_ub)"
  shows "<\<Gamma> * timeCredit_assn Cost_ub> c <\<lambda>r. \<Gamma>' * (\<exists>\<^sub>Ara. R ra r * \<up>(ra \<in> dom M)) >\<^sub>t"
  using assms(1)  unfolding hn_refine_def
  unfolding hoare_triple_def
  apply clarify
proof (goal_cases)
  case (1 h as \<sigma> r n t)
  from 1(2) have 2: "pHeap h as (n-Cost_ub) \<Turnstile> \<Gamma>" and  nf: "n\<ge>Cost_ub"
    using mod_timeCredit_dest by auto

  from 1(1) have 3: "\<And>h as n Ma.
       pHeap h as n \<Turnstile> \<Gamma> \<Longrightarrow>
      SPECT M = SPECT Ma \<Longrightarrow> (\<exists>h' t r. execute c h = Some (r, h', t) \<and>
       (\<exists>ra Ca. Ma ra \<ge> Some (enat Ca) \<and> t \<le> n + Ca \<and> pHeap h' (new_addrs h as h') ((n + Ca) - t) \<Turnstile> \<Gamma>' * R ra r * true) \<and>
      relH {a. a < heap.lim h \<and> a \<notin> as} h h' \<and> heap.lim h \<le> heap.lim h')"
    by auto

  thm effect_deterministic

  from 3[OF 2 ] obtain h' t' r' where E: "execute c h = Some (r', h', t') " and
    R:  "(\<exists>ra Ca. M ra \<ge> Some (enat Ca) \<and>
                    pHeap h' (new_addrs h as h') (n - Cost_ub + Ca - t') \<Turnstile> \<Gamma>' * R ra r' * true \<and> t' \<le> n - Cost_ub + Ca) \<and>
           relH {a. a < heap.lim h \<and> a \<notin> as} h h' \<and> heap.lim h \<le> heap.lim h'" by blast

  have F: "\<sigma> = Some h'" and prime: "r' = r" "t' = t"
    using E 1(3) run.cases apply force
    using E 1(3) run.cases apply force
    using E 1(3) run.cases by force
  then have sig: "the \<sigma> = h'" by auto
  from R  have
    B: "(\<exists>ra Ca. M ra \<ge> Some (enat Ca) \<and>
     pHeap (the \<sigma>) (new_addrs h as (the \<sigma>)) (n - Cost_ub + Ca - t) \<Turnstile> \<Gamma>' * R ra r * true \<and>
        t \<le> n - Cost_ub + Ca )" and C:
    "relH {a. a < heap.lim h \<and> a \<notin> as} h (the \<sigma>)" "heap.lim h \<le> heap.lim (the \<sigma>) "
    unfolding prime sig by auto

  from B obtain ra Ca where i: "pHeap (the \<sigma>) (new_addrs h as (the \<sigma>)) (n - Cost_ub + Ca - t) \<Turnstile> \<Gamma>' * R ra r * true"
    and ii:  "t \<le> n - Cost_ub + Ca"  and ineq: "M ra \<ge> Some (enat Ca)"
    using B by auto

  from ineq have radom: "ra \<in> dom M" using domIff by fastforce
  then obtain Mra where Mra: "M ra = Some Mra" by blast
  with assms(2) have "Mra \<le> enat Cost_ub" by (meson ranI)
  with Mra ineq have "Some (enat Ca) \<le> Some (enat Cost_ub)"
    using dual_order.trans by fastforce
  then have ie: "Ca \<le> Cost_ub" by auto

  have pr: "(n - Cost_ub + Ca - t) = (n - t) - (Cost_ub - Ca)" using ie ii nf by auto
  have pl: "(n - (t + (Cost_ub - Ca)) + (Cost_ub - Ca)) = n-t" using ii nf by auto

  have "pHeap (the \<sigma>) (new_addrs h as (the \<sigma>) \<union> {}) ((n - t) - (Cost_ub - Ca) + (Cost_ub - Ca)) \<Turnstile> \<Gamma>' * R ra r * true * true"
    apply(rule mod_star_convI)  apply simp
     apply(rule i[unfolded pr])  by (simp add: top_assn_rule)

  then have H: "pHeap (the \<sigma>) (new_addrs h as (the \<sigma>)) (n - t) \<Turnstile> \<Gamma>' * R ra r * true * true"
    by (simp add: pl)

  have "pHeap (the \<sigma>) (new_addrs h as (the \<sigma>)) (n - t) \<Turnstile> \<Gamma>' * R ra r * \<up> (ra \<in> dom M) * true"
    apply(rule entailsD[OF _ H]) using radom by auto2
  then have "\<exists>ra. pHeap (the \<sigma>) (new_addrs h as (the \<sigma>)) (n - t) \<Turnstile> \<Gamma>' * R ra r * \<up> (ra \<in> dom M) * true"
    by blast
  then have H': "pHeap (the \<sigma>) (new_addrs h as (the \<sigma>)) (n - t) \<Turnstile> (\<exists>\<^sub>Ara. \<Gamma>' *  R ra r * \<up> (ra \<in> dom M) * true)"
    using mod_ex_dist by blast
  have H: "pHeap (the \<sigma>) (new_addrs h as (the \<sigma>)) (n - t) \<Turnstile> \<Gamma>' * (\<exists>\<^sub>Ara. R ra r * \<up> (ra \<in> dom M)) * true"
    apply(rule entailsD[OF _ H']) by auto2

  from ii ie nf have T: "t \<le> n " by auto

  show ?case
    apply safe
    subgoal using F by auto
    subgoal using H by simp
    subgoal by fact
     apply fact apply fact done
qed

lemma r: "ran (\<lambda>v. if M v then Some (t v) else None) = {t v |v. M v}"
  by (auto simp: ran_is_image domIff split: if_splits)

lemma d: "ra \<in> dom (\<lambda>v. if M v then Some (t v) else None) \<longleftrightarrow> M ra"
  unfolding domIff by (auto)

lemma extract_cost_ub_SPEC: "hn_refine \<Gamma> c \<Gamma>' R (SPEC M t) \<Longrightarrow> (\<And>c. M c \<Longrightarrow> t c \<le> enat Cost_ub) \<Longrightarrow> <\<Gamma> * timeCredit_assn Cost_ub> c <\<lambda>r. \<Gamma>' * (\<exists>\<^sub>Ara. R ra r * \<up> (M ra))>\<^sub>t"
  unfolding SPEC_def
  apply(drule extract_cost_ub[where Cost_ub=Cost_ub])
  by (auto simp: r d)

lemma hnr_hoare_triple_SPEC_conv: "hn_refine \<Gamma> c \<Gamma>' R (SPEC P (\<lambda>_. t)) =  <\<Gamma> * timeCredit_assn t> c <\<lambda>r. \<Gamma>' * (\<exists>\<^sub>Ara. R ra r * \<up> (P ra))>\<^sub>t"
  apply(rule)
  subgoal apply(rule extract_cost_ub_SPEC) by auto
  subgoal unfolding SPEC_def apply(rule extract_cost_otherway[where Cost_lb="t" and F="emp"])
       defer apply assumption apply (auto split:  if_splits simp: domIff)[]
    apply solve_entails
apply (auto split:  if_splits simp: domIff)[]
    by(auto split: if_splits simp: ran_def)
  done

lemma post_rulet:
  "<P> f <Q>\<^sub>t \<Longrightarrow> \<forall>x. Q x \<Longrightarrow>\<^sub>A R x * true \<Longrightarrow> <P> f <R>\<^sub>t"
  apply(rule post_rule[where Q="\<lambda>x. Q x * true"])
  apply auto apply(rule ent_true_drop(1)) by simp

 lemma ht_cons_rule:
  assumes CPRE: "P \<Longrightarrow>\<^sub>A P'"
  assumes CPOST: "\<And>x. Q x \<Longrightarrow>\<^sub>A Q' x"
  assumes R: "<P'> c <Q>"
  shows "<P> c <Q'>" apply(rule cons_post_rule[OF _ CPOST])
   by(rule pre_rule[OF CPRE R])

lemma extract_cost_ub':
  assumes "hn_refine \<Gamma> c \<Gamma>' R (REST M)" "(\<And>c. c\<in>ran M \<Longrightarrow> c \<le> Cost_ub)"
   and pre: "P \<Longrightarrow>\<^sub>A \<Gamma> * timeCredit_assn Cost_ub"
   and post: "\<forall>r. \<Gamma>' * (\<exists>\<^sub>Ara. R ra r * \<up>(ra \<in> dom M)) \<Longrightarrow>\<^sub>A Q r * true"
 shows "<P> c <Q>\<^sub>t"
  apply(rule pre_rule[OF pre])
  apply(rule post_rulet[OF _ post])
  apply(rule extract_cost_ub) by fact+

lemma hn_refineI:
  shows "tt = enat ttt ==> <\<Gamma> * timeCredit_assn ttt> C <\<lambda>r. \<Gamma>' *  RR ra r>\<^sub>t \<Longrightarrow> hn_refine \<Gamma> C \<Gamma>'  RR (SPECT [ra \<mapsto> tt])"
    apply(rule extract_cost_otherway[where F=emp and Cost_lb=ttt and G=" \<Gamma> * timeCredit_assn ttt"])
     apply solve_entails apply simp  apply simp apply solve_entails by simp
lemma RETURNT_SPECT_conv: "RETURNT r = SPECT [r \<mapsto> 0]" unfolding RETURNT_def by auto
lemma hn_refineI0:
  shows "<\<Gamma>> C <\<lambda>r. \<Gamma>' *  RR ra r>\<^sub>t \<Longrightarrow> hn_refine \<Gamma> C \<Gamma>'  RR (RETURNT ra)"
  unfolding RETURNT_SPECT_conv
    apply(rule extract_cost_otherway[where F=emp and Cost_lb=0 and G=" \<Gamma> * timeCredit_assn 0"])
     apply solve_entails apply (simp add: zero_time)  apply simp apply solve_entails by (simp add: zero_enat_def)

end


section \<open>Implementation of Heaps with Arrays\<close>
theory IICF_Impl_Heap
imports
  IICF_Abs_Heap
  "../IICF_Array"
  "../IICF_Array_List"
begin

  (* TODO: Move *)

  term al_assn

  (* TODO: Move *)
  lemma size_mset_param[param]: "(size,size)\<in>\<langle>A\<rangle>mset_rel \<rightarrow> nat_rel"
    by (auto simp: mset_rel_def p2rel_def rel_mset_size)

  (* TODO: Move *)
  lemma rdomp_ref_mk_assn_iff[simp]: "rdomp \<upharpoonleft>(mk_assn A) = rdomp A"
    by (auto simp: rdomp_def)

  thm vcg_prep_ext_rules

  find_theorems pure_part

  lemma rdomp_arl_assn_len:
    assumes "rdomp \<upharpoonleft>(arl_assn:: ('a::llvm_rep list, 'l::len2 word \<times> 'l word \<times> 'a ptr) dr_assn) xs"
    shows "length xs < max_snat LENGTH('l)"
    using assms
    by (auto
      simp: rdomp_def arl_assn_def arl_assn'_def sep_algebra_simps pred_lift_extract_simps
      simp: snat.assn_def
      )

  find_theorems vassn_tag hn_refine

  (* TODO: Very specialized workaround lemma, to work around invalid-recombination
    problem for case that B is pure
  *)
  lemma workaround_invalid_recombine_pure2: "is_pure B \<Longrightarrow> hn_ctxt (invalid_assn A \<times>\<^sub>a B) ax px \<turnstile> hn_invalid (A \<times>\<^sub>a B) ax px"
    unfolding hn_ctxt_def invalid_assn_def prod_assn_def entails_def
    by (auto split: prod.split elim!: is_pureE
      simp: sep_algebra_simps pure_part_pure_conj_eq)
    argo

  (* TODO: Move
    TODO: Should be generic algorithm!
  *)
  lemma mop_list_swap_unfold: "mop_list_swap xs i j = do {
    xi \<leftarrow> mop_list_get xs i;
    xj \<leftarrow> mop_list_get xs j;
    xs \<leftarrow> mop_list_set xs i xj;
    mop_list_set xs j xi
  }"
  by (auto simp: pw_eq_iff refine_pw_simps swap_def)

  text \<open>We implement the heap data structure by an array.
    The implementation is automatically synthesized by the Sepref-tool.
    \<close>
  subsection \<open>Setup of the Sepref-Tool\<close>

  (* TODO: Move *)
  lemma mset_rel_id: "\<langle>Id\<rangle>mset_rel = Id"
    unfolding mset_rel_def apply (simp add: rel2p multiset.rel_eq)
    by (simp only: p2rel)

  locale heap_impl = heapstruct prio for prio :: "'e \<Rightarrow> 'p::linorder" +
    fixes prio_assn :: "'p \<Rightarrow> 'pi::llvm_rep \<Rightarrow> assn"
      and elem_assn :: "'e \<Rightarrow> 'ei::llvm_rep \<Rightarrow> assn"
      and prio_impl le_prio_impl lt_prio_impl
      and ltype :: "'l::len2 itself"
    assumes prio_is_pure[safe_constraint_rules]: "is_pure prio_assn"
    assumes elem_is_pure[safe_constraint_rules]: "is_pure elem_assn"
    assumes prio_impl_refine[sepref_fr_rules]: "(prio_impl, RETURN o prio)\<in>elem_assn\<^sup>k \<rightarrow>\<^sub>a prio_assn"
    assumes le_prio_impl_refine[sepref_fr_rules]:
      "(uncurry le_prio_impl, uncurry (RETURN oo (\<le>))) \<in> prio_assn\<^sup>k *\<^sub>a prio_assn\<^sup>k \<rightarrow>\<^sub>a bool1_assn"
    assumes lt_prio_impl_refine[sepref_fr_rules]:
      "(uncurry lt_prio_impl, uncurry (RETURN oo (<))) \<in> prio_assn\<^sup>k *\<^sub>a prio_assn\<^sup>k \<rightarrow>\<^sub>a bool1_assn"

    fixes N defines "N\<equiv>LENGTH('l)"
    (*assumes l_len[simp,arith]: "4 < LENGTH('l)"*)
  begin

    abbreviation "assn \<equiv> al_assn' TYPE('l) elem_assn"
    abbreviation "idx_assn \<equiv> snat_assn' TYPE('l)"
    definition "heap_assn \<equiv> hr_comp (al_assn elem_assn) heap_rel1"

    lemma mk_free_heap_assn[sepref_frame_free_rules]: "MK_FREE heap_assn arl_free"
      unfolding heap_assn_def
      by (rule sepref_frame_free_rules)+

    (*context
      assumes l_len_pre: "(4 < LENGTH('l))"
    begin
      private lemma l_len: "4 < LENGTH('l)" using l_len_pre unfolding vcg_tag_defs by auto
    *)

      sepref_register prio

      sepref_register "(\<le>) :: 'p \<Rightarrow> 'p \<Rightarrow> bool"
      sepref_register "(<) :: 'p \<Rightarrow> 'p \<Rightarrow> bool"

      lemmas [sepref_frame_free_rules] =
        mk_free_is_pure[OF prio_is_pure]
        mk_free_is_pure[OF elem_is_pure]

      sepref_register update_op
      sepref_definition update_impl is "uncurry2 update_op"
        :: "assn\<^sup>d *\<^sub>a idx_assn\<^sup>k *\<^sub>a elem_assn\<^sup>k \<rightarrow>\<^sub>a assn"
        unfolding update_op_def[abs_def]
        apply (annot_snat_const "TYPE('l)")
        by sepref
      lemmas [sepref_fr_rules] = update_impl.refine

      sepref_register val_of_op
      sepref_definition val_of_impl is "uncurry val_of_op" :: "assn\<^sup>k *\<^sub>a idx_assn\<^sup>k \<rightarrow>\<^sub>a elem_assn"
        unfolding val_of_op_def[abs_def]
        apply (annot_snat_const "TYPE('l)")
        by sepref
      lemmas [sepref_fr_rules] = val_of_impl.refine

      sepref_register exch_op
      sepref_definition exch_impl is "uncurry2 exch_op" :: "assn\<^sup>d *\<^sub>a idx_assn\<^sup>k *\<^sub>a idx_assn\<^sup>k \<rightarrow>\<^sub>a assn"
        unfolding exch_op_def[abs_def] mop_list_swap_unfold
        apply (annot_snat_const "TYPE('l)")
        by sepref

      lemmas [sepref_fr_rules] = exch_impl.refine

      sepref_register valid
      sepref_definition valid_impl is "uncurry (RETURN oo valid)" :: "assn\<^sup>k *\<^sub>a idx_assn\<^sup>k \<rightarrow>\<^sub>a bool1_assn"
        unfolding valid_def[abs_def]
        apply (annot_snat_const "TYPE('l)")
        by sepref
      lemmas [sepref_fr_rules] = valid_impl.refine

      sepref_register prio_of_op
      sepref_definition prio_of_impl is "uncurry (PR_CONST prio_of_op)" :: "assn\<^sup>k *\<^sub>a idx_assn\<^sup>k \<rightarrow>\<^sub>a prio_assn"
        unfolding prio_of_op_def[abs_def] PR_CONST_def
        by sepref
      lemmas [sepref_fr_rules] = prio_of_impl.refine

      sepref_definition append_impl is "uncurry mop_list_append"
        :: "[\<lambda>(xs,_). length xs + 1 < max_snat LENGTH('l)]\<^sub>a assn\<^sup>d *\<^sub>a elem_assn\<^sup>k \<rightarrow> assn"
        by sepref
      lemmas [sepref_fr_rules] = append_impl.refine

      sepref_register swim_op
      sepref_definition swim_impl is
        "uncurry (PR_CONST swim_op)" :: "[\<lambda>_. 4<LENGTH('l)]\<^sub>a assn\<^sup>d *\<^sub>a idx_assn\<^sup>k \<rightarrow> assn"
        unfolding swim_op_def[abs_def] parent_def PR_CONST_def
        apply (annot_snat_const "TYPE('l)")
        (* TODO: Workaround/Hack *)
        supply [sepref_frame_match_rules] = workaround_invalid_recombine_pure2[where B=snat_assn, simplified]
        by sepref_dbg_keep

      lemmas [sepref_fr_rules] = swim_impl.refine

      lemma overflow_safe_hbound_check: "2*k\<le>n \<longleftrightarrow> k\<le>n div 2" for k n :: nat by auto

      (*lemma bound_aux1: "rdomp assn xs \<Longrightarrow> j\<le>length xs div 2 \<Longrightarrow> 2*j < max_snat LENGTH('l)"
        apply sepref_bounds*)

      (*
      lemma bound_aux2: "\<lbrakk>rdomp assn a1'; 2 * a2' < length a1'\<rbrakk>
        \<Longrightarrow> Suc (2 * a2') < max_snat LENGTH('l)"
        apply sepref_bounds
        apply (drule al_assn_len_bound)
        by auto
      *)

      sepref_register sink_op
      sepref_definition sink_impl is "uncurry (PR_CONST sink_op)" :: "[\<lambda>_. 4<LENGTH('l)]\<^sub>a assn\<^sup>d *\<^sub>a idx_assn\<^sup>k \<rightarrow> assn"
        unfolding sink_op_opt_def[abs_def] sink_op_opt_eq[symmetric,abs_def]  PR_CONST_def
        unfolding overflow_safe_hbound_check Suc_eq_plus1
        (* TODO: Workaround/Hack *)
        supply [sepref_frame_match_rules] = workaround_invalid_recombine_pure2[where B=snat_assn, simplified]
        apply (annot_snat_const "TYPE('l)")
        by sepref

      lemmas [sepref_fr_rules] = sink_impl.refine

      lemma prenorm_heaprel1_len: "(h,m)\<in>heap_rel1 \<Longrightarrow> length h = size m"
        unfolding heap_rel1_def in_br_conv
        by auto
      lemma max_snat_param: "(max_snat,max_snat)\<in>nat_rel \<rightarrow> nat_rel" by simp

      context
        notes [fcomp_norm_unfold] = heap_assn_def[symmetric] list_rel_id_simp mset_rel_id
        notes [fcomp_prenorm_simps] = prenorm_heaprel1_len
        notes [param] = IdI[of N] max_snat_param
      begin

        sepref_definition empty_impl is "uncurry0 empty_op" :: "[\<lambda>_. 4<N]\<^sub>a unit_assn\<^sup>k \<rightarrow> assn"
          unfolding empty_op_def N_def
          apply (rewrite al_fold_custom_empty[where 'l='l])
          by sepref
        sepref_decl_impl (no_register) heap_empty: empty_impl.refine[FCOMP empty_op_refine]
          uses op_mset_empty.fref[of Id] .

        sepref_definition is_empty_impl is "is_empty_op" :: "assn\<^sup>k \<rightarrow>\<^sub>a bool1_assn"
          unfolding is_empty_op_def[abs_def]
          apply (annot_snat_const "TYPE('l)")
          by sepref
        sepref_decl_impl heap_is_empty: is_empty_impl.refine[FCOMP is_empty_op_refine]
          uses op_mset_is_empty.fref[of Id] .

        sepref_definition insert_impl
          is "uncurry insert_op" :: "[\<lambda>(_,xs). 4<N \<and> length xs+1 < max_snat N]\<^sub>a elem_assn\<^sup>k *\<^sub>a assn\<^sup>d \<rightarrow> assn"
          unfolding insert_op_def[abs_def] append_op_def N_def
          by sepref
        sepref_decl_impl heap_insert: insert_impl.refine[FCOMP insert_op_refine]
          uses op_mset_insert.fref[of Id] .

        sepref_definition pop_min_impl is "pop_min_op" :: "[\<lambda>_. 4<N]\<^sub>a assn\<^sup>d \<rightarrow> elem_assn \<times>\<^sub>a assn"
          unfolding pop_min_op_def[abs_def] butlast_op_def N_def
          apply (annot_snat_const "TYPE('l)")
          by sepref
        sepref_decl_impl (no_mop) heap_pop_min: pop_min_impl.refine[FCOMP pop_min_op_refine]
          uses op_prio_pop_min.fref[of Id] .

        sepref_definition peek_min_impl is "peek_min_op" :: "assn\<^sup>k \<rightarrow>\<^sub>a elem_assn"
          unfolding peek_min_op_def[abs_def]
          apply (annot_snat_const "TYPE('l)")
          by sepref
        sepref_decl_impl (no_mop) heap_peek_min: peek_min_impl.refine[FCOMP peek_min_op_refine]
          uses op_prio_peek_min.fref[of Id] .

      end
    (*end        *)

  end

  global_interpretation heap_impl id snat_assn snat_assn return ll_icmp_sle ll_icmp_slt "TYPE('l::len2)" "LENGTH('l)"
    defines h_update_impl = update_impl
        and h_val_of_impl = val_of_impl
        and h_exch_impl = exch_impl
        and h_valid_impl = valid_impl
        and h_prio_of_impl = prio_of_impl
        and h_append_impl = append_impl
        and h_swim_impl = swim_impl
        and h_sink_impl = sink_impl
        and h_empty_impl = empty_impl
        and h_is_empty_impl = is_empty_impl
        and h_insert_impl = insert_impl
        and h_pop_min_impl = pop_min_impl
        and h_peek_min_impl = peek_min_impl

    apply unfold_locales
    apply (rule pure_pure)
    apply sepref
    apply sepref
    apply sepref
    apply simp
    done

  lemmas heap_impl_inlines =
    heap_impl.valid_impl_def[OF heap_impl_axioms]
    heap_impl.prio_of_impl_def[OF heap_impl_axioms]
    heap_impl.val_of_impl_def[OF heap_impl_axioms]
    heap_impl.append_impl_def[OF heap_impl_axioms]
    heap_impl.exch_impl_def[OF heap_impl_axioms]
    heap_impl.empty_impl_def[OF heap_impl_axioms]
    heap_impl.is_empty_impl_def[OF heap_impl_axioms]
    heap_impl.insert_impl_def[OF heap_impl_axioms]
    heap_impl.pop_min_impl_def[OF heap_impl_axioms]
    heap_impl.peek_min_impl_def[OF heap_impl_axioms]

    h_swim_impl_def[symmetric]
    h_sink_impl_def[symmetric]

  lemmas [llvm_inline] = update_impl_def
  lemmas [llvm_inline] = val_of_impl_def
  lemmas [llvm_inline] = exch_impl_def
  lemmas [llvm_inline] = h_valid_impl_def[unfolded heap_impl_inlines]
  lemmas [llvm_inline] = h_prio_of_impl_def[unfolded heap_impl_inlines]
  lemmas [llvm_inline] = h_append_impl_def[unfolded heap_impl_inlines]
  lemmas [llvm_code] = h_swim_impl_def[unfolded heap_impl.swim_impl_def[OF heap_impl_axioms], unfolded heap_impl_inlines]
  lemmas [llvm_code] = h_sink_impl_def[unfolded heap_impl.sink_impl_def[OF heap_impl_axioms], unfolded heap_impl_inlines]
  lemmas [llvm_inline] = h_empty_impl_def[unfolded heap_impl_inlines]
  lemmas [llvm_inline] = h_is_empty_impl_def[unfolded heap_impl_inlines]
  lemmas [llvm_inline] = h_insert_impl_def[unfolded heap_impl_inlines]
  lemmas [llvm_inline] = h_pop_min_impl_def[unfolded heap_impl_inlines]
  lemmas [llvm_inline] = h_peek_min_impl_def[unfolded heap_impl_inlines]

  definition [simp]: "op_heap_custom_empty (_::'a::len2 itself) (_::'l::len2 itself) \<equiv> op_mset_empty"
  context fixes Q T :: "_::len2 itself" begin sepref_register "op_heap_custom_empty Q T" end

  lemma op_heap_custom_empty_hnr[sepref_fr_rules]:
    shows "(
      uncurry0 (empty_impl::('a::len2 word,'l)array_list llM ),
      uncurry0 (RETURN (PR_CONST (op_heap_custom_empty TYPE('a) TYPE('l))))) \<in> [\<lambda>_. 4<LENGTH('l::len2)]\<^sub>a unit_assn\<^sup>k \<rightarrow> heap_assn"
    unfolding op_heap_custom_empty_def PR_CONST_def
    by (rule heap_empty_hnr[unfolded PRECOND_def])

  lemma heap_fold_custom_empty:
    "{#} = op_heap_custom_empty TYPE('a::len2) TYPE('l::len2)"
    "op_mset_empty = op_heap_custom_empty TYPE('a::len2) TYPE('l::len2)"
    "mop_mset_empty = RETURN (op_heap_custom_empty TYPE('a::len2) TYPE('l::len2))"
    by auto

definition "sort_by_prio l\<^sub>0 \<equiv> do {
  q \<leftarrow> nfoldli l\<^sub>0 (\<lambda>_. True) (\<lambda>x q. do { ASSERT (size q < length l\<^sub>0); mop_mset_insert x q }) {#};
  ASSERT (q = mset l\<^sub>0);
  (l,q) \<leftarrow> WHILEIT (\<lambda>(l,q). sorted l \<and> (\<forall>x\<in>set l. \<forall>y\<in>#q. x\<le>y) \<and> mset l + q = mset l\<^sub>0)
    (\<lambda>(l,q). \<not>op_mset_is_empty q) (\<lambda>(l,q).
  do {
    (x,q) \<leftarrow> mop_prio_pop_min id q;
    ASSERT (size l < length l\<^sub>0);
    RETURN (l@[x],q)
  }) (op_list_empty,q);
  RETURN l
}"

lemma sort_by_prio_correct: "sort_by_prio l \<le> SPEC (\<lambda>l'. sorted l' \<and> mset l' = mset l)"
  unfolding sort_by_prio_def mop_prio_pop_min_def

  apply (refine_vcg
    nfoldli_rule[where I="\<lambda>ll _ q. q = mset ll"]
    WHILEIT_rule[where R="measure (\<lambda>(l,q). size q)"]
    )
  apply (auto 0 3 dest: in_diffD simp: size_Diff1_less sorted_append_bigger)
  subgoal by (metis add_cancel_right_right le_add1 nat_less_le size_eq_0_iff_empty size_mset size_union)
  subgoal by (metis insert_DiffM union_iff)
  done

(* TODO: Move  *)
function list_intv_induction where
  "list_intv_induction l u = (if l<u then list_intv_induction (Suc l) u else ())"
  by pat_completeness auto

termination
  apply (relation "measure (\<lambda>(l,u). u-l)")
  by auto

(*
lemma nfoldli_range_to_while: "nfoldli [l..<u] c f \<sigma> = do {
    (_,\<sigma>) \<leftarrow> WHILET
      (\<lambda>(i,\<sigma>). i<u \<and> c \<sigma>)
      (\<lambda>(i,\<sigma>). do { \<sigma> \<leftarrow> f i \<sigma>; ASSERT (i<u); RETURN (i+1,\<sigma>) })
      (l,\<sigma>);
    RETURN \<sigma>
  }"
proof (induction l u arbitrary: \<sigma> rule: list_intv_induction.induct)
  case (1 l u)
  show ?case proof (cases "l<u")
    case False thus ?thesis
      by (rewrite WHILET_unfold) simp

  next
    case True
    thm "1.IH"[OF True, abs_def]
    thus ?thesis
      by (rewrite WHILET_unfold) (simp add: upt_conv_Cons "1.IH"[OF True, abs_def])
  qed
qed
*)

sepref_definition sort_impl [llvm_code] is
  "sort_by_prio" :: "[\<lambda>l. length l < max_snat LENGTH(64)]\<^sub>a (al_assn' TYPE(64) (snat_assn' TYPE(64)))\<^sup>k \<rightarrow> al_assn' TYPE(64) (snat_assn' TYPE(64))"
  unfolding sort_by_prio_def[abs_def]
  apply (rewrite nfoldli_by_idx)
  apply (rewrite nfoldli_upt_by_while)
  apply (rewrite heap_fold_custom_empty[where 'l=64 and 'a="64"])
  apply (rewrite at op_list_empty al_fold_custom_empty[where 'l=64])
  apply (annot_snat_const "TYPE(64)")
  by sepref

export_llvm (no_header)
  sort_impl is "sort"
  "arl_new_raw :: (64 word,64) array_list llM" is "arl_new"
  "arl_push_back :: _ \<Rightarrow> _ \<Rightarrow> (64 word,64) array_list llM" is "arl_push_back"
  file "sort.ll"
  (* CAREFUL: The calling conventions generated by this LLVM code are hard/impossible to
    interface from C !? *)

end


theory ringBufFifoModi imports paraGste1
begin
abbreviation rst::"expType" where
"rst \<equiv> IVar (Ident ''rst'')"

abbreviation push::"expType" where
"push \<equiv> IVar (Ident ''push'')"

abbreviation pop::"expType" where
"pop \<equiv> IVar (Ident ''pop'')"

abbreviation dataIn::"expType" where
"dataIn \<equiv> IVar (Ident ''dataIn'' )"

abbreviation LOW::"expType" where
"LOW \<equiv> Const (boolV False)"
abbreviation HIGH::"expType" where
" HIGH \<equiv> Const (boolV True)"

abbreviation emptyFifo::"expType" where
" emptyFifo \<equiv> IVar (Ident ''empty'' ) "

abbreviation tail::"expType" where
" tail \<equiv> IVar (Ident ''tail'' ) "

abbreviation head::"expType" where
" head \<equiv> IVar (Ident ''head'' ) "

abbreviation full::"expType" where
" full \<equiv> IVar (Ident ''full'' ) "

definition fullForm::"formula" where [simp]:
" fullForm \<equiv> eqn full HIGH "

abbreviation mem::"varType" where
"mem \<equiv>  ( (Ident ''mem'') )"

type_synonym paraExpType="nat \<Rightarrow>expType"

abbreviation dataOut::"nat\<Rightarrow>expType" where
"dataOut DEPTH \<equiv> read (Ident ''mem'') DEPTH (IVar (Ident ''head'' ))"

abbreviation rstForm::"formula" where
"rstForm  \<equiv>  (eqn rst HIGH)"

abbreviation emptyForm::"formula" where
"emptyForm  \<equiv>  (eqn emptyFifo HIGH)"

abbreviation pushForm::"formula" where
"pushForm \<equiv> andForm (andForm (eqn rst LOW) (eqn push HIGH)) (eqn pop LOW)"

abbreviation popForm::"formula" where
"popForm \<equiv> andForm (andForm (eqn rst LOW) (eqn push LOW)) (eqn pop HIGH)"

abbreviation nPushPopForm::"formula" where
"nPushPopForm \<equiv> andForm (andForm (eqn rst LOW) (eqn push LOW)) (eqn pop LOW)"

abbreviation pushDataForm::"nat \<Rightarrow>formula" where
" pushDataForm D \<equiv>andForm pushForm  (eqn dataIn (Const (index D)))"

abbreviation popDataForm::"nat\<Rightarrow>nat \<Rightarrow>formula" where
" popDataForm DEPTH D \<equiv>  (eqn (dataOut DEPTH) (Const (index D)))"

abbreviation nFullForm::"formula" where
"nFullForm \<equiv>  neg (fullForm )"

abbreviation nEmptyForm::"formula" where
"nEmptyForm \<equiv> neg emptyForm "

definition  vertexI::"node" where [simp]:
"vertexI \<equiv>Vertex  0"

(*DEPTH=LAST + 1*)
definition  vertexL::"nat \<Rightarrow> node list" where [simp]:
"vertexL LAST  \<equiv>  vertexI # (map (%i. Vertex  i) (down LAST))"

definition edgeL::"nat \<Rightarrow> edge list" where [simp]:
 "edgeL LAST \<equiv> [Edge vertexI ( Vertex 1)]
    @ [Edge  ( Vertex 1) ( Vertex 3)]
    @ [Edge  ( Vertex 1) ( Vertex 4)]

		@(map (%i.  ( Edge (Vertex ( 2*i+1 ))  (Vertex (  2*i+1 ))) ) (upt 0  (LAST+2) ))  (* self-loop*)
	  @(map (%i.  ( Edge (Vertex ( 2*i+2 ))  (Vertex (  2*i+2 ))) ) (upt 1 (LAST+2) ))  (* self-loop*)

		@(map (%i.   ( Edge (Vertex (2 * i + 1))  (Vertex (2 * i + 3))) ) ( upt 1 (LAST+1)))
		@(map (%i.   ( Edge (Vertex (2 * i + 1))  (Vertex (2 * i + 4))) ) ( upt 1 (LAST+1)))

		@(map (%i.   ( Edge (Vertex (2 * i + 3))  (Vertex (2 * i + 1))) ) (  upt 0 (LAST+1) ))
		@(map (%i.   ( Edge (Vertex (2 * i + 4))  (Vertex (2 * i +2 ))) ) (  upt 1 (LAST+1) ))
		@[ Edge (Vertex 4) (Vertex 1)]
	 "

(*
edgeL LAST \<equiv> [Edge vertexI ( Vertex 1)]
    @ [Edge  ( Vertex 1) ( Vertex 3)]
    @ [Edge  ( Vertex 1) ( Vertex 4)]

		@(map (%i.  ( Edge (Vertex ( 2*i+1 ))  (Vertex (  2*i+1 ))) ) (upt 0  (LAST+2) ))  (* self-loop*)
	  @(map (%i.  ( Edge (Vertex ( 2*i+2 ))  (Vertex (  2*i+2 ))) ) (upt 1  (LAST+2) ))  (* self-loop*)

		@(map (%i.   ( Edge (Vertex (2 * i + 1))  (Vertex (2 * i + 3))) ) ( upt 1 (LAST+1)))
		@(map (%i.   ( Edge (Vertex (2 * i + 1))  (Vertex (2 * i + 4))) ) ( upt 1 (LAST+1)))

		@(map (%i.   ( Edge (Vertex (2 * i + 3))  (Vertex (2 * i + 1))) ) (  upt 0 (LAST+1) ))
		@(map (%i.   ( Edge (Vertex (2 * i + 4))  (Vertex (2 * i + 2))) ) (  upt 1 (LAST+1) ))
		@[Edge  ( Vertex 4) ( Vertex 1)]
;*)
primrec node2Nat::"node \<Rightarrow> nat" where
"node2Nat (Vertex n) = n"

definition antOfRbFifo::"nat\<Rightarrow>edge\<Rightarrow>formula" where [simp]:
"antOfRbFifo  D  edge\<equiv>
  (let from=node2Nat (source edge) in
   let to=node2Nat (sink edge) in
  ( if (	from = 0) then rstForm	else
     if (from=to) then nPushPopForm else
   ( if ((from mod 2) =1) then
     (
       if ((from + 2)=to) then ( pushForm ) else
       if (from=(to + 2)) then popForm else
       pushDataForm D )   else
     popForm)))"

(*definition antOfRbFifo::"nat\<Rightarrow>edge\<Rightarrow>formula" where [simp]:
"antOfRbFifo  D  edge\<equiv>
  (let from=node2Nat (source edge) in
   let to=node2Nat (sink edge) in
   if (from = 0) then rstForm	else
   if (from=to) then nPushPopForm else
      (if ((from mod 2) =1) then
        (
          if ((from + 2)=to) then ( pushForm ) else
          if (from=(to + 2)) then popForm else
          pushDataForm D )
       else popForm))"

definition consOfRbFifo::"nat\<Rightarrow>nat\<Rightarrow>edge \<Rightarrow>formula" where  [simp]:
"consOfRbFifo   D LAST edge \<equiv>
(let from=node2Nat (source edge) in
 let to=node2Nat (sink edge) in
 if 	(((from mod 2) = 1) \<and> ((to mod 2) = 1)) then
    (if  from =1 then (andForm  emptyForm (nFullForm LAST))
     else if    (from = (2*LAST+3)) then (andForm nEmptyForm (fullForm LAST))
     else andForm nEmptyForm (nFullForm LAST))
 else if (from=4 \<and> to = 1) then popDataForm LAST D
 else if (from = (2*LAST+4)) then (andForm nEmptyForm (fullForm LAST))
 else if (from =1 )  then (andForm emptyForm (nFullForm LAST))
 else if (from \<noteq>0)   then (andForm nEmptyForm (nFullForm LAST))
 else chaos)"

let cons aEdge =
	val (Edge (Vertex from) (Vertex to)) = aEdge
in
	((from%2) = 1) AND ((to%2) = 1) =>
		(from = 1) => TAndList [empty,nFull]		//FIFO is empty
	|	(from = (2*DEPTH+1)) => TAndList [nEmpty,full]	//FIFO is full
	|	TAndList [nEmpty,nFull]					//FIFO of other size
|	(to = 2) => popData vOfDataIn					//read the write data
| 	TAndList []
;*)

definition consOfRbFifo::"nat\<Rightarrow>nat\<Rightarrow>edge \<Rightarrow>formula" where  [simp]:
"consOfRbFifo   D LAST edge \<equiv>
let from=node2Nat (source edge) in
let to=node2Nat (sink edge) in
 (if 	(((from mod 2) = 1) \<and> ((to mod 2) = 1)) then
  (if  from =1 then (andForm  emptyForm (nFullForm))
  else if    (from = (2*LAST+3)) then (andForm nEmptyForm (fullForm ))
  else andForm nEmptyForm (nFullForm ))
 else if (from=4 \<and> to = 1) then popDataForm LAST D
 else if (from = (2*LAST+4)) then (andForm nEmptyForm (fullForm))
 else if (from =1 )  then (andForm emptyForm (nFullForm ))
 else if (from \<noteq>0)   then (andForm nEmptyForm (nFullForm))
 else chaos)"

definition rbFifoGsteSpec::" nat\<Rightarrow>nat\<Rightarrow>gsteSpec" where  [simp]:
"rbFifoGsteSpec LAST  data\<equiv>Graph  vertexI (edgeL  LAST ) (antOfRbFifo data )  (consOfRbFifo data  LAST)"

primrec applyPlusN::"expType\<Rightarrow>nat \<Rightarrow>expType" where
"applyPlusN e 0=e" |
"applyPlusN e (Suc N) = uif ''+'' [applyPlusN e N, Const (index 1)]"

definition tagFunOfRingBufFifo:: " nat\<Rightarrow>nat\<Rightarrow>nodeTagFuncList" where [simp]:
"tagFunOfRingBufFifo DATA LAST  n \<equiv>
  let x=node2Nat n in
   let DataE=(Const (index DATA)) in
   let LASTE=(Const (index LAST)) in
   let TwiceLASTPlus3=(Const (index (2*LAST +3))) in
   let tailPlus=uif ''+'' [tail, (Const (index 1))] in
   let headPlus=uif ''+'' [head, (Const (index 1))] in
   if (x = 0) then [] else
    (if ((x mod 2) = 1) then
      (if (x =1) then
        [eqn tail head, eqn  emptyFifo HIGH,
        eqn full LOW,uip ''le'' [head,LASTE]]
       else
       (if (x=2*LAST+3) then
        [eqn tail (applyPlusN head (x div 2  )),
        eqn  emptyFifo LOW,
        (*eqn emptyFifo (iteForm (eqn tail  headPlus)  HIGH emptyFifo),
        eqn full (iteForm (eqn tailPlus  head)  HIGH full),*)
        eqn full  HIGH,
        uip ''le'' [head,LASTE]
        ]
        else
         [eqn tail (applyPlusN head (x div 2  )),
         eqn  emptyFifo LOW,
         eqn full LOW,uip ''le'' [head,LASTE]]
         (* eqn emptyFifo (iteForm (eqn tail  headPlus)  HIGH emptyFifo),
          eqn full (iteForm (eqn tailPlus  head)  HIGH full),*)
        (* uip ''le'' [head,LASTE]]*) ) )
    else
    ((*if (x = 2) then []
     else *)
        (if (x=2*LAST+4) then
        [eqn tail (applyPlusN head (x div 2 - 1 ) ),
        eqn emptyFifo LOW,
        eqn full HIGH,uip ''le'' [head,LASTE],
        eqn (read mem LAST (applyPlusN head (x div 2  - 2))) DataE ]
        else
         [eqn tail (applyPlusN head (x div 2  - 1)), eqn  emptyFifo LOW,
         eqn full LOW, uip ''le'' [head,LASTE],

          eqn (read mem LAST (applyPlusN head (x div 2  - 2))) DataE ]))
     )

 "

 abbreviation branch1::"generalizeStatement" where
"branch1 \<equiv>
  (let S1=assign (Ident ''head'',(Const (index 0))) in
   let S2=assign (Ident ''tail'',(Const (index 0))) in
   let S3=assign (Ident ''empty'',HIGH) in
   let S4=assign (Ident ''full'',LOW) in
   Parallel [S1,S2,S3,S4])"

abbreviation branch2::"nat\<Rightarrow>generalizeStatement" where
"branch2 LAST \<equiv>
  (let S1=map (\<lambda>i. assign ((Para (Ident ''mem'') i),
    iteForm (eqn tail (Const (index i)))  dataIn
    (IVar (Para (Ident ''mem'')  i)))) (down LAST ) in
   let tailPlus=uif ''+'' [tail, (Const (index 1))] in
   let S2=assign (Ident ''tail'', tailPlus ) in
   let S3=assign (Ident ''empty'',LOW) in
   let S4=assign (Ident ''full'',iteForm (eqn tailPlus  head)  HIGH full) in
   (* Parallel (S1@[S2,S3]))*)
   Parallel ([S2,S3,S4]@S1))"

abbreviation branch3::"generalizeStatement" where
"branch3 \<equiv>
  (let headPlus=uif ''+'' [head, (Const (index 1))] in
    Parallel [
    assign (Ident ''empty'',iteForm (eqn tail  headPlus)  HIGH emptyFifo),
    assign (Ident ''full'', LOW),
    assign (Ident ''head'',  headPlus)] )
    "

abbreviation ringBuffifo::" nat\<Rightarrow>generalizeStatement" where
"ringBuffifo  LAST\<equiv>
  caseStatement
     [(eqn rst HIGH, branch1),
      (andForm (eqn push HIGH) (nFullForm), branch2 LAST),
      (andForm (eqn pop HIGH) (eqn emptyFifo LOW), branch3)]
   "

consts J::"nat \<Rightarrow> interpretFunType"

axiomatization where axiomOnIAdd [simp,intro]:
"  J LAST ''+'' [index m,   index (Suc 0)] = index ((m + 1) mod (Suc LAST  ))"
(* (if m=LAST  then (index 0) else (index (m +1 )))"
index ((m + 1) mod (Suc LAST  )) " *)

axiomatization where axiomOnLe [simp,intro]:
"  J LAST  ''le'' [index m, index n]  = boolV (m \<le> n)"

axiomatization where headIsIndex[simp,intro]:"\<exists>i. ((s (Ident ''head'') ) = (index i)) "

lemma test0: "formEval (J LAST) (eqn (Var tail) (applyPlusN head i) ) s  \<longrightarrow>
formEval (J LAST) (eqn (uif ''+''  [Var tail, Const (index 1)]) (applyPlusN head (i+1)) ) s"
apply(auto) done

lemma auxOnReadWrite[simp]:
"expEval I e s=expEval I e' s \<and>expEval I e s=index i\<and> i\<le> LAST \<longrightarrow>(\<forall>j. Para mem j \<notin>set (varOfExp e'))\<longrightarrow>

        expEval I  (substExp (caseExp (map (\<lambda>i. (eqn e' (Const (index i)), IVar (Para mem i))) (down LAST)))
            (map (\<lambda>i. (Para mem i, iteForm (eqn e (Const (index i))) e'' (IVar (Para mem i))))
              (down LAST)))
          s = expEval I e'' s "   (is "?P LAST")
proof(induct_tac LAST)
  show "?P 0"
  proof(rule impI)+
  assume a1:" expEval I e s = expEval I e' s \<and> expEval I e s = index i \<and> i \<le> 0" and
   a2:" \<forall>j. Para mem j \<notin> set (varOfExp e')"
   have a3:"(Para mem 0) \<notin> set (varOfExp e')"
    by(cut_tac a2,auto)
  show " expEval I
     (substExp (caseExp (map (\<lambda>i. (eqn e' (Const (index i)), IVar (Para mem i))) (down 0)))
       (map (\<lambda>i. (Para mem i, iteForm (eqn e (Const (index i))) e'' (IVar (Para mem i)))) (down 0)))
     s =
    expEval I e'' s"
   using a1 a3 noEffectSubstExp proof(cut_tac a1,auto)qed
   qed
  next
  fix n
  assume a0:  "?P n"
  show "?P (Suc n)"
  proof(rule impI)+
  assume a1:" expEval I e s = expEval I e' s \<and> expEval I e s = index i \<and> i \<le> Suc n" and
   a2:" \<forall>j. Para mem j \<notin> set (varOfExp e')"
   have a3:"(Para mem  (Suc n)) \<notin> set (varOfExp e')"
    by(cut_tac a2,auto)
   show "expEval I
     (substExp (caseExp (map (\<lambda>i. (eqn e' (Const (index i)), IVar (Para mem i))) (down (Suc n))))
       (map (\<lambda>i. (Para mem i, iteForm (eqn e (Const (index i))) e'' (IVar (Para mem i)))) (down (Suc n))))
     s =
    expEval I e'' s" (is "?LHS (Suc n) =?RHS")
   proof(case_tac "i \<le> n")
     assume b1:"i \<le> n"
     have b2:" (Para mem (Suc n)) \<notin> set (varOfExp
     (caseExp (map (\<lambda>i. (eqn e' (Const (index i)), IVar (Para mem i))) (down n))))"
      apply(auto)
      apply (simp add: SucnIsNotInDownn)
      by (simp add: a3)

     have b3:"?LHS (Suc n) =?LHS n"
     using a1 a2 a3 b1 b2 by auto
     have b4:"?LHS n =   expEval I e'' s"
     using a1 b1 a2 a0 apply auto  done
     show "?LHS (Suc n) =?RHS"
     using b4 b3 by auto
   next
    assume b1:"\<not>i \<le> n"
    have b2:"i=Suc n"
    using b1 a1 by auto
    show "?LHS (Suc n) =?RHS"
     using b1 b2 a1 a2 a3  apply auto done
  qed
qed
qed

lemma caseExpCong:
  assumes a:"tautlogy (eqn e e') I"
  shows "expEval I   (caseExp (map (\<lambda>i. (eqn e (Const (index i)), IVar (Para mem i))) (down LAST))) s
  =expEval I  (caseExp (map (\<lambda>i. (eqn e' (Const (index i)), IVar (Para mem i))) (down LAST))) s"
proof(induct_tac LAST,(cut_tac a,simp)+)qed

lemma caseExpCong1:
  assumes a:"formEval I (eqn e e') s "
  shows "expEval I   (caseExp (map (\<lambda>i. (eqn e (Const (index i)), IVar (Para mem i))) (down LAST))) s
  =expEval I  (caseExp (map (\<lambda>i. (eqn e' (Const (index i)), IVar (Para mem i))) (down LAST))) s"
proof(induct_tac LAST,(cut_tac a,simp)+)qed

lemma readWrite[simp,intro!]:
assumes a1:"expEval I e s=expEval I e' s " and a2:"expEval I e s=index i" and a3:" i\<le> LAST " and
a2:"(\<forall>j. Para mem j \<notin>set (varOfExp e'))"

shows " expEval I  (substExp (caseExp (map (\<lambda>i. (eqn e' (Const (index i)), IVar (Para mem i))) (down LAST)))
            (map (\<lambda>i. (Para mem i, iteForm (eqn e (Const (index i))) e'' (IVar (Para mem i))))
              (down LAST)))
          s = expEval I e'' s "
using a2 a3 assms(2) auxOnReadWrite local.a1 by blast

lemma varOfApplyPlus[simp]:
  "varOfExp (applyPlusN head i) = [(Ident ''head'' )]"
  apply(induct_tac i,auto) done

lemma onApplyPlusI[simp]:"i \<le> LAST \<longrightarrow>
  j \<le> LAST \<longrightarrow> s (Ident ''head'') = index j \<longrightarrow>
  expEval (J LAST) (applyPlusN head i) s = index ((j + i) mod (Suc LAST))  "
  proof(induct_tac i,auto,arith) qed

lemma onApplyPlusII[simp]:"0<i\<longrightarrow>i\<le> LAST \<longrightarrow>
  j \<le> LAST \<longrightarrow> s (Ident ''head'') = index j \<longrightarrow>
expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (i - Suc 0)) s = index ((j + i) mod (Suc LAST))" (is "?P i")
  proof(induct_tac i,simp,case_tac "n=0",simp)
    fix n
    assume a:"?P n" and b:"~n=0"
    show "?P (Suc n)"
    proof(rule impI)+
      assume c1:"0< Suc n" and c2:"Suc n \<le> LAST" and c3:"j \<le> LAST" and c4:"s (Ident ''head'') = index j"
      show "
      expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (Suc n - Suc 0)) s = index ((j + Suc n) mod Suc LAST)"
      (is "?LHS =?RHS")
      proof -
      have d1:"0<n" by(cut_tac b,simp)
      have d2:"n <LAST" by(cut_tac c2,simp)
      have d3:"(applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (Suc n - Suc 0)) =
      uif ''+'' [(applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (n -Suc 0)), Const (index (Suc 0))]"
      by (metis One_nat_def Suc_pred applyPlusN.simps(2) d1 diff_Suc_1)
      have d4:"expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (n - Suc 0)) s=index ((j + n) mod (Suc LAST))"
        apply(cut_tac a d1 d2 d3 c3 c4,simp) done

      show "?LHS=?RHS"
      apply(cut_tac d3 d4,simp)
      using mod_Suc_eq_Suc_mod by auto
    qed
   qed
qed

lemma test1[simp]: " (expEval (J LAST) (applyPlusN head (Suc i)) s) = J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)]"
  apply simp done

lemma test2[simp]:"Suc j \<le> LAST \<longrightarrow> (Suc j + (Suc LAST)) mod (Suc LAST) =Suc ((j + (Suc LAST)) mod (Suc LAST))" (is "?P j")
by (metis Divides.mod_less le_less_trans lessI less_trans mod_add_self2)

lemma test3:"j \<le> LAST \<longrightarrow> (j + (Suc LAST)) mod (Suc LAST) =j" (is "?P j")
by (metis Divides.mod_less le_imp_less_Suc mod_add_self2)

lemma test4[simp]:"0<LAST \<longrightarrow>i < Suc LAST \<longrightarrow> 0 < i \<longrightarrow>
  j \<le> LAST \<longrightarrow> ((j + i) mod (Suc LAST)) =
  (if (j+i)< (Suc LAST) then j+i else (j+i -(Suc LAST)))"  (is "?P LAST")
using le_mod_geq by force

lemma test5Aux[simp]:"0<LAST \<longrightarrow>i < Suc LAST \<longrightarrow> 0 < i \<longrightarrow>
  j \<le> LAST \<longrightarrow> ((j + i) mod (Suc LAST)) \<noteq> j"
using nat_neq_iff not_less by auto

lemma test5:
  assumes a1:" 0 < LAST " and a2:" i < Suc LAST" and a3:" 0 < i " and
  a4:"j \<le> LAST"
  shows " ((j + i) mod (Suc LAST)) \<noteq> j"
      using a1 a2 a3 a4 test5Aux by auto

lemma  iPlus1IsNotI:
  assumes a1:"0 < LAST" and
  a2:"J LAST ''+'' [s (Ident ''head''), index (Suc 0)] = s (Ident ''head'')"
  (*and *a3:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])"*)
  shows False
  proof -
    have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
      using headIsIndex by auto
    then obtain i where b1:"((s (Ident ''head'') ) = (index i))"
      by blast
   (* have b2:"i\<le> LAST"
     using a1 a3 b1 axiomOnLe  apply auto        done*)
    show False
       apply(cut_tac a1 a2 b1 ,case_tac "i=LAST",auto)
       by (metis mod_Suc mod_mod_trivial n_not_Suc_n nat.inject)

  qed

lemma iPlusSucLatIsi:
  assumes a:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])"
  shows "J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)]=  s (Ident ''head'')"
   proof -
    have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
      using headIsIndex by auto
    then obtain i where b1:"((s (Ident ''head'') ) = (index i))"
      by blast
    have b2:"i\<le> LAST"
     using a b1 axiomOnLe  apply auto   done
    show ?thesis
    apply(cut_tac b1 b2,simp)
    by (metis (full_types) Divides.mod_less add.commute add_Suc le_imp_less_Suc mod_Suc_eq_Suc_mod mod_add_self1)
qed

lemma  iPlusjPLUSIsNotj:
  assumes a1:"0 < LAST"  and a4:"i < LAST" and
  a3:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])"

  shows "J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)]\<noteq>s (Ident ''head'')"
proof -
    have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
      using headIsIndex by auto
    then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
      by blast
    have b2:"j\<le> LAST"
     using a1 a3 b1 axiomOnLe  apply auto        done
    have b3: "J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)]  =index ((j + Suc i) mod (Suc LAST))"
    by (metis Suc_eq_plus1 a4 b1 b2 discrete le_Suc_eq onApplyPlusI test1)

    have b4:"Suc i< Suc LAST"
    by (simp add: a4)  thm test5
    have b5:"((j + (Suc i)) mod (Suc LAST)) \<noteq>j"
    apply (cut_tac a1  b2 b4 ,rule test5,auto)
    done
    with b3 show "J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] \<noteq> s (Ident ''head'')"
    by (simp add: b1)

qed
lemma substApplyHead[simp]:
  "substExp (applyPlusN head n) [(Ident ''head'', uif ''+'' [head, Const (index (Suc 0))])] =
         applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) n"
proof(induct_tac n,auto)qed

lemma applyIPlusIsPlusI:
"J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] =
         expEval (J LAST) (substExp (applyPlusN head i)
         [(Ident ''head'', uif ''+'' [head, Const (index (Suc 0))])]) s"
proof(induct_tac i,auto)qed

lemma substCaseExp:
  "substExp
   (caseExp
     (map (\<lambda>i. (g i,e i)) (down LAST)))
      subst0 =
    caseExp
      (map (\<lambda>i. (substForm (g i) subst0, substExp (e i) subst0))
      (down LAST))"        (is "?P LAST")
proof(induct_tac LAST,simp)
  fix n
  assume b:"?P n"
  show "?P (Suc n)" (is "substExp (?caseExp (Suc n)) subst0= caseExp (?list (Suc n))")
  proof -
  have c1:"substExp (?caseExp (Suc n)) subst0=
          substExp (caseExp ((g (Suc n), e (Suc n))#(map (\<lambda>i. (g i,e i)) (down n)))) subst0" (is "?LHS =?RHS1")
    apply (simp only:downSuc ,auto) done
  have c2:"?RHS1 =iteForm (substForm (g (Suc n)) subst0) (substExp (e (Suc n)) subst0) (caseExp (?list n))"
      (is "?RHS1=?RHS2")
      by (simp add: b)
  have c3:"?RHS2=caseExp ((substForm (g (Suc n)) subst0,substExp (e (Suc n)) subst0)#(?list n))"
      (is "?RHS2=?RHS3")
    by(simp )
  have c4:"?RHS3=caseExp (?list (Suc n))"
    by simp
    with c1 c2 c3 show "?P (Suc n)"
    by presburger
  qed
qed

lemma substCaseExp1:
  "substExp
   (caseExp
     (map (\<lambda>i. (eqn (applyPlusN head (j - Suc 0)) (Const (index i)), IVar (Para mem i))) (down LAST)))
      [(Ident ''head'', uif ''+'' [head, Const (index (Suc 0))])] =
    caseExp
      (map (\<lambda>i. (eqn (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (j - Suc 0)) (Const (index i)), IVar (Para mem i)))
      (down LAST))"        (is "?P LAST")
using substCaseExp by auto

lemma consistencyOfRbfifo0:
  assumes a:"LAST=0 "
  shows "consistent' (ringBuffifo LAST ) (J LAST) (rbFifoGsteSpec LAST  data)
  (tagFunOfRingBufFifo  data LAST)"
  proof(unfold consistent'_def,rule allI,rule impI)
    fix e
    let ?G=" (rbFifoGsteSpec LAST  data)"
    let ?M="(ringBuffifo LAST )"
    let ?tag="(tagFunOfRingBufFifo  data LAST)"
    let ?P ="\<lambda>e.
    (let f=andListForm (?tag (sink e)) in
    let f'=andListForm (?tag (source e)) in
    tautlogy (implyForm (andForm f' (antOf ?G e)) (preCond1  f  ( ?M))) (J LAST))"

    assume a1:"e \<in> edgesOf (rbFifoGsteSpec LAST  data)"

    have "e=Edge vertexI ( Vertex 1) |
          e=Edge  ( Vertex 1) ( Vertex 3) |
          e=Edge  ( Vertex 1) ( Vertex 4)|
           (\<exists>i. 0\<le>i \<and> i\<le> LAST + 1 \<and>  e=( Edge (Vertex ( 2*i+1 ))  (Vertex (  2*i+1 ))) )   |
            (\<exists>i. 1\<le>i \<and> i\<le> LAST + 1 \<and>  e=( Edge (Vertex ( 2*i+2 ))  (Vertex (  2*i+2 ))) ) |

           e=Edge  ( Vertex 3) ( Vertex 1) |
           e=Edge (Vertex 4) (Vertex 1)"
      apply(cut_tac a a1,auto)  done
   moreover
    {assume b1:"e=Edge vertexI ( Vertex 1)"
     have "?P e"
     apply(cut_tac b1, simp add:antOfRbFifo_def)
     done
     }
    moreover
    {assume b1:" (\<exists>i. 0\<le>i \<and> i\<le> LAST +1  \<and>  e=( Edge (Vertex (2* i + 1))  (Vertex (  2*i + 1))) )  " (is "\<exists>i. ?asm i")
     from b1 obtain i where b2:"?asm i" by auto
      have "?P e"
       apply(cut_tac b2, simp add:antOfRbFifo_def substNIl) done
    }
    moreover
    {assume b1:" (\<exists>i. 1\<le>i \<and> i\<le> LAST+1 \<and>  e=( Edge (Vertex (2* i + 2))  (Vertex (  2*i + 2))) )  " (is "\<exists>i. ?asm i")
     from b1 obtain i where b2:"?asm i" by auto
      have "?P e"
       apply(cut_tac b2, simp add:antOfRbFifo_def substNIl) done
    }
     moreover
    {assume b1:" e=Edge  ( Vertex 1) ( Vertex 3) "

       let ?P' ="\<lambda>e.
       (let f=andListForm (?tag (sink e)) in
       let f'=andListForm (?tag (source e)) in
       tautlogy (implyForm (andForm f' (antOf ?G e)) (preCond1  f  (branch2 LAST))) (J LAST))"

        let ?P1="\<lambda>e.
       (let f=andListForm (?tag (sink e)) in
       let f'=andListForm (?tag (source e)) in
       let tailPlus=uif ''+'' [tail, (Const (index 1))] in
       let f1=andListForm [eqn tailPlus (applyPlusN head 1), eqn  LOW LOW,
         eqn full LOW, uip ''le'' [head,LASTE]] in
       tautlogy (implyForm (andForm f' (antOf ?G e)) f1) (J LAST))"
       have c1:"?P e= ?P' e"
        by (simp add: a b1 del:tautlogy_def,auto)

      (* have c2:"?P' e=?P1 e"
        apply (cut_tac a b1,simp del:tautlogy_def add:Let_def)
        apply(rule onIfExpPos)
        apply*)
        have "?P e "
       proof(cut_tac a b1,auto simp add:Let_def )
       fix s
       assume c1:"scalar2Bool (J 0 ''le'' [s (Ident ''head''), index 0]) " and
       c2:" J 0 ''+'' [s (Ident ''head''), index (Suc 0)] \<noteq> s (Ident ''head'')"
       have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
       using headIsIndex by auto
       then obtain i where b1:"((s (Ident ''head'') ) = (index i))"
          by blast
       have b2:"i=0"
       using a c1 b1 axiomOnLe  apply auto        done
       show False
       apply(cut_tac b1 b2 c2 , auto) done

       qed

    }

     moreover
    {assume b1:" e=Edge  ( Vertex 1) ( Vertex 4) "
      let ?f="andForm (neg (eqn rst HIGH)) (andForm (eqn push HIGH) nFullForm ) "
       have "?P e "
       proof(cut_tac a b1,auto simp add:Let_def)
          fix s::state
          assume c1:"s (Ident ''head'') \<noteq> index 0 " and
          c2:"scalar2Bool (J 0 ''le'' [s (Ident ''head''), index 0])"
          have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
             using headIsIndex by auto
          then obtain i where b1:"((s (Ident ''head'') ) = (index i))"
             by blast
          have b2:"i=0"
            using a c2 b1 axiomOnLe  apply auto        done
          show False
          apply(cut_tac b1 b2 c1 , auto) done
       qed
    }
    moreover
    {assume b1:"e=Edge  ( Vertex 3) ( Vertex 1)"

     have b3:"varOfExp (applyPlusN head i) =[Ident ''head'']"
        by simp
     have "?P e"
     proof(cut_tac a b1 b3,auto simp add:antOfRbFifo_def Let_def)
     fix s
     assume c1:" scalar2Bool (J 0 ''le'' [s (Ident ''head''), index 0])"
     have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
        using headIsIndex by auto
     then obtain i where b1:"((s (Ident ''head'') ) = (index i))"
        by blast
     have b2:"i=0"
        using a c1 b1 axiomOnLe  apply auto        done
     show "scalar2Bool (J 0 ''le'' [J 0 ''+'' [s (Ident ''head''), index (Suc 0)], index 0])"
      apply(cut_tac b1 b2,auto)
     done
     qed
     }
    moreover
    {assume b1:"e=Edge  ( Vertex 4) ( Vertex 1)"

     have b3:"varOfExp (applyPlusN head i) =[Ident ''head'']"
        by simp
     have "?P e"
     proof(cut_tac a b1 b3,auto simp add:antOfRbFifo_def Let_def)
     qed
     }
    ultimately show "?P e" by satx
qed

lemma consistencyOfRbfifo:
  assumes a:"0 < LAST "
  shows "consistent' (ringBuffifo LAST ) (J LAST) (rbFifoGsteSpec LAST  data)
  (tagFunOfRingBufFifo  data LAST)"
  proof(unfold consistent'_def,rule allI,rule impI)
    fix e
    let ?G=" (rbFifoGsteSpec LAST  data)"
    let ?M="(ringBuffifo LAST )"
    let ?tag="(tagFunOfRingBufFifo  data LAST)"
    let ?P ="\<lambda>e.
    (let f=andListForm (?tag (sink e)) in
    let f'=andListForm (?tag (source e)) in
    tautlogy (implyForm (andForm f' (antOf ?G e)) (preCond1  f  ( ?M))) (J LAST))"

    assume a1:"e \<in> edgesOf (rbFifoGsteSpec LAST  data)"

    have "e=Edge vertexI ( Vertex 1) |
          e=Edge  ( Vertex 1) ( Vertex 3) |
          e=Edge  ( Vertex 1) ( Vertex 4)|
           (\<exists>i. 0\<le>i \<and> i\<le> LAST+1 \<and>  e=( Edge (Vertex ( 2*i+1 ))  (Vertex (  2*i+1 ))) )   |
            (\<exists>i. 1\<le>i \<and> i\<le> LAST+1 \<and>  e=( Edge (Vertex ( 2*i+2 ))  (Vertex (  2*i+2 ))) ) |

           (\<exists>i. 1\<le>i \<and> i\<le> LAST  \<and> e=( Edge (Vertex (2 * i + 1))  (Vertex (2 * i + 3))) ) |
           (\<exists>i. 1\<le>i \<and> i\<le> LAST  \<and> e=( Edge (Vertex (2 * i + 1))  (Vertex (2 * i + 4))) )  |

           (\<exists>i. 0\<le>i \<and> i\<le> LAST  \<and>  e= ( Edge (Vertex (2 * i + 3))  (Vertex (2 * i + 1))) ) |
           (\<exists>i. 1\<le>i \<and> i\<le> LAST   \<and> e=( Edge (Vertex(2 * i + 4))  (Vertex(2 *i+ 2))))|
           e=Edge (Vertex 4) (Vertex 1)"
      apply(cut_tac a a1,auto)  done
    moreover
    {assume b1:"e=Edge vertexI ( Vertex 1)"
     have "?P e"
     apply(cut_tac b1, simp add:antOfRbFifo_def)
     done
     }
    moreover
    {assume b1:" (\<exists>i. 0\<le>i \<and> i\<le> LAST+1  \<and>  e=( Edge (Vertex (2* i + 1))  (Vertex (  2*i + 1))) )  " (is "\<exists>i. ?asm i")
     from b1 obtain i where b2:"?asm i" by auto
      have "?P e"
       apply(cut_tac b2, simp add:antOfRbFifo_def substNIl) done
    }
    moreover
    {assume b1:" (\<exists>i. 1\<le>i \<and> i\<le> LAST+1  \<and>  e=( Edge (Vertex (2* i + 2))  (Vertex (  2*i + 2))) )  " (is "\<exists>i. ?asm i")
     from b1 obtain i where b2:"?asm i" by auto
      have "?P e"
       apply(cut_tac b2, simp add:antOfRbFifo_def substNIl) done
    }
     moreover
    {assume b1:" e=Edge  ( Vertex 1) ( Vertex 3) "

       let ?P' ="\<lambda>e.
       (let f=andListForm (?tag (sink e)) in
       let f'=andListForm (?tag (source e)) in
       tautlogy (implyForm (andForm f' (antOf ?G e)) (preCond1  f  (branch2 LAST))) (J LAST))"

        let ?P1="\<lambda>e.
       (let f=andListForm (?tag (sink e)) in
       let f'=andListForm (?tag (source e)) in
       let tailPlus=uif ''+'' [tail, (Const (index 1))] in
       let f1=andListForm [eqn tailPlus (applyPlusN head 1), eqn  LOW LOW,
         eqn full LOW, uip ''le'' [head,LASTE]] in
       tautlogy (implyForm (andForm f' (antOf ?G e)) f1) (J LAST))"
       have c1:"?P e= ?P' e"
        by (simp add: a b1 del:tautlogy_def,auto)

        have "?P e "
       proof(cut_tac a b1,auto simp add:Let_def )
       fix s
       assume c1:"0 <LAST" and
       c2:" J LAST ''+'' [s (Ident ''head''), index (Suc 0)] = s (Ident ''head'')"

       show False
       apply(cut_tac c1 c2 , blast intro:  iPlus1IsNotI ) done

       qed

    }

     moreover
    {assume b1:" e=Edge  ( Vertex 1) ( Vertex 4) "
      let ?f="andForm (neg (eqn rst HIGH)) (andForm (eqn push HIGH) nFullForm ) "
      have b2:"2*LAST +4 \<noteq> 4" apply(cut_tac a,arith) done
       have "?P e "
       proof(cut_tac a b1 b2,auto simp add:Let_def)
          fix s::state
          assume a1:"0 <LAST" and
          a2:"J LAST ''+'' [s (Ident ''head''), index (Suc 0)] = s (Ident ''head'')"

          show False
          apply(cut_tac a a2 , blast intro:  iPlus1IsNotI ) done
        next
          fix s
          assume a1:"s (Ident ''tail'') = s (Ident ''head'')" and
          a2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])" and
          a3:"s (Ident ''dataIn'') = index data"
          have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
          using headIsIndex by auto
          then obtain i where b1:"((s (Ident ''head'') ) = (index i))"
          by blast
          have b2:"i\<le> LAST"
          using a1 a2 b1 axiomOnLe  apply auto        done
          have b3:"
          expEval (J LAST)
          (substExp
            (caseExp (map (\<lambda>i. (eqn head (Const (index i)), IVar (Para mem i))) (down LAST)))
            (map (\<lambda>i. (Para mem i,
                       iteForm (eqn tail (Const (index i))) dataIn (IVar (Para mem i))))
              (down LAST)))
          s =
         expEval (J LAST) dataIn s" thm auxOnReadWrite
          using a1 a2 b1 b2  by auto
          show "
          expEval (J LAST)
          (substExp
            (caseExp (map (\<lambda>i. (eqn head (Const (index i)), IVar (Para mem i))) (down LAST)))
            (map (\<lambda>i. (Para mem i,
                       iteForm (eqn tail (Const (index i))) dataIn (IVar (Para mem i))))
              (down LAST)))
          s =
         index data"
          using a3 b3  by auto
     qed
    }

    moreover
    {assume b1:" \<exists>i. 1\<le>i \<and> i \<le>LAST \<and> e=Edge  ( Vertex (2*i + 1)) ( Vertex (2*i + 3))"     (is "\<exists>i. ?Q i")
      from b1 obtain i where b1:"?Q i" by blast
      have b2:"i - 1 < LAST" by(cut_tac a b1,auto)
      have b3:"varOfExp (applyPlusN head i) =[Ident ''head'']" by auto
      have "i=LAST \<or> i <LAST" by(cut_tac b1 ,auto)
      moreover
      {assume b4:"i =LAST"
      have "?P e "
      proof(cut_tac  a b1  b3 b4,auto simp add: antOfRbFifo_def assms Let_def)
        fix s
        assume  a1:"J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)] \<noteq> s (Ident ''head'')" and
          a2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])"

          have b1:"J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)]= s (Ident ''head'')"
          by (simp add: a2 iPlusSucLatIsi)
          with a1 b1 show False by auto
      qed
      }
      moreover
      {assume b4:" i <LAST"
      have "?P e "
      proof(cut_tac  a b1 b3 b4,auto simp add: antOfRbFifo_def assms Let_def)
        fix s
        assume c1:" Suc 0 \<le> i " and c2:" i < LAST " and c3:"
        J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] = s (Ident ''head'')"
        and c4:"scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST]) "
        have c1:"0< i" by(cut_tac c1,simp)
        have c5:"J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] \<noteq> s (Ident ''head'')"
        using assms c1 c2 c4 iPlusjPLUSIsNotj by blast

        with c3 show False by simp

      qed
      }
      ultimately have "?P e " by satx

     }

    moreover
    {assume b1:" \<exists>i. 1\<le>i \<and> i\<le> LAST \<and> e=Edge  ( Vertex (2*i + 1)) ( Vertex (2*i+4))    "(is "\<exists>i. ?Q i")
     from b1 obtain i where b1:"?Q i" by blast
      have b2:"i - 1 < LAST" by(cut_tac a b1,auto)
      have b3:"varOfExp (applyPlusN head i) =[Ident ''head'']"
        by simp
      have "i=LAST \<or> i <LAST" by(cut_tac b1 ,auto)
      moreover
      {assume b4:"i =LAST"
      have "?P e "
      proof(cut_tac  a b1  b3 b4,auto simp add:  assms Let_def)
        fix s
        assume  a1:"J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)] \<noteq> s (Ident ''head'')" and
          a2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])"

          have b1:"J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)]= s (Ident ''head'')"
          by (simp add: a2 iPlusSucLatIsi)
          with a1 b1 show False by auto
      next
         fix s
          assume
          a4:"s (Ident ''tail'') = expEval (J LAST) (applyPlusN head LAST) s" and
          a2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])" and
          a3:"s (Ident ''dataIn'') = index data"

          have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
          using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
          by blast
          have b2:"j\<le> LAST"
          using  a2 b1 axiomOnLe  apply auto        done
          (*have a0:"s (Ident ''tail'') = s (Ident ''head'')"*)
          have b3:"
          expEval (J LAST)
          (substExp
            (caseExp (map (\<lambda>i. (eqn (applyPlusN head LAST) (Const (index i)), IVar (Para mem i))) (down LAST)))
            (map (\<lambda>i. (Para mem i,
                       iteForm (eqn tail (Const (index i))) dataIn (IVar (Para mem i))))
              (down LAST)))
          s =
         expEval (J LAST) dataIn s" thm auxOnReadWrite
          using a4 a2 b1 b2  by auto
          show "
          expEval (J LAST)
          (substExp
            (caseExp (map (\<lambda>i. (eqn (applyPlusN head LAST) (Const (index i)), IVar (Para mem i))) (down LAST)))
            (map (\<lambda>i. (Para mem i,
                       iteForm (eqn tail (Const (index i))) dataIn (IVar (Para mem i))))
              (down LAST)))
          s =
         index data"
          using a3 b3  by auto
     qed

      }
      moreover
      {assume b4:" i <LAST"
      have "?P e "
      proof(cut_tac  a b1 b3 b4,auto simp add: antOfRbFifo_def assms Let_def)
        fix s
        assume c1:" Suc 0 \<le> i " and c2:" i < LAST " and c3:"
        J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] = s (Ident ''head'')"
        and c4:"scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST]) "

        have c1:"0< i" by(cut_tac c1,simp)
        have c5:"J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] \<noteq> s (Ident ''head'')"
        using assms c1 c2 c4 iPlusjPLUSIsNotj by blast

        with c3 show False by simp

      next
        fix s
        assume
          a4:"s (Ident ''tail'') = expEval (J LAST) (applyPlusN head i) s" and
          a2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])" and
          a3:"s (Ident ''dataIn'') = index data"

          have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
          using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
          by blast
          have b2:"j\<le> LAST"
          using  a2 b1 axiomOnLe  apply auto        done
          have b3:"expEval (J LAST) tail s = index ((j +i) mod (Suc LAST))"
            apply(cut_tac a4,simp)
            by (simp add: b1 b2 b4 less_or_eq_imp_le)
          have b4:"(j +i) mod (Suc LAST) \<le> LAST"   by simp
          (*have a0:"s (Ident ''tail'') = s (Ident ''head'')"*)

          have b5:"expEval (J LAST)
          (substExp
            (caseExp (map (\<lambda>i'. (eqn (applyPlusN head i) (Const (index i')), IVar (Para mem i'))) (down LAST)))
            (map (\<lambda>i'. (Para mem i',
                       iteForm (eqn tail (Const (index i'))) dataIn (IVar (Para mem i'))))
              (down LAST)))
          s =
         expEval (J LAST) dataIn s" thm readWrite
            apply(cut_tac b3 b4,  rule readWrite,auto)
            by (simp add: a4)
          show "expEval (J LAST)
          (substExp
            (caseExp (map (\<lambda>i'. (eqn (applyPlusN head i) (Const (index i')), IVar (Para mem i'))) (down LAST)))
            (map (\<lambda>i'. (Para mem i',
                       iteForm (eqn tail (Const (index i'))) dataIn (IVar (Para mem i'))))
              (down LAST)))
          s =
         index data"
          using a3 b5  by auto
      qed
      }
      ultimately have "?P e " by satx

     }

     moreover
    {assume b1:"\<exists>i. 0\<le>i \<and> i\<le> LAST \<and>  e=Edge  ( Vertex (2*i + 3)) ( Vertex (2*i + 1))   " (is "\<exists>i. ?Q i")
       from b1 obtain i where b1:"?Q i" by blast
      have b2:"i - 1 < LAST" by(cut_tac a b1,auto)
      have b3:"varOfExp (applyPlusN head i) =[Ident ''head'']"
        by simp
      have "i=LAST \<or> i <LAST" by(cut_tac b1 ,auto)
      moreover
      {assume b4:"i =LAST"
      have "?P e "
      proof(cut_tac  a b1  b3 b4,auto simp add:  assms Let_def)
        fix s
        assume b5:" LAST = 0"
        with a show "scalar2Bool (J 0 ''le'' [J 0 ''+'' [s (Ident ''head''), index (Suc 0)], index 0])" by simp
      next
        fix s
        assume c1:"J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)]
          = J LAST ''+'' [s (Ident ''head''), index (Suc 0)]" and
        c2:"scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])"
        have d1:"J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)]= s (Ident ''head'')"
          by (simp add: c2 iPlusSucLatIsi)

        have d2:"J LAST ''+'' [expEval (J LAST) (applyPlusN head 0) s, index (Suc 0)] =
        J LAST ''+'' [s (Ident ''head''), index (Suc 0)] "
        apply(simp) done thm iPlusjPLUSIsNotj
        have d3:"J LAST ''+'' [expEval (J LAST) (applyPlusN head 0) s, index (Suc 0)]\<noteq> s (Ident ''head'')"
        apply(cut_tac a c2,rule  iPlusjPLUSIsNotj,auto)  done
        with d1 d2 c1 show False
        by simp
      next
        fix s
        show "  J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)] =
         expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) LAST) s"
         using applyIPlusIsPlusI by auto
      next
        fix s

          have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
            by blast
          show "scalar2Bool (J LAST ''le'' [J LAST ''+'' [s (Ident ''head''), index (Suc 0)], index LAST])"
          apply(cut_tac b1,auto) done
      qed
     }
     moreover
      {assume b4:"i <LAST"
      have "?P e "
      proof(cut_tac  a b1  b3 b4,auto simp add:  assms Let_def)
      fix s
      have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
            by blast
      show "scalar2Bool (J LAST ''le'' [J LAST ''+'' [s (Ident ''head''), index (Suc 0)], index LAST])"
        apply(cut_tac b1,auto) done

     next
      fix s
      assume c1:" J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] =
      J LAST ''+'' [s (Ident ''head''), index (Suc 0)]" and
      c2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])" and c3:"0<i"
       have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
          then obtain j where e1:"((s (Ident ''head'') ) = (index j))"
            by blast
        have e2:"j\<le> LAST"
          using  c2 e1 axiomOnLe  apply auto        done thm  onApplyPlusI
        have e3:"expEval (J LAST) (applyPlusN head i) s= index ((j +i) mod Suc LAST)"
          by (simp add: e1 e2 b4 less_imp_le_nat)

        show False
       apply(cut_tac a b1 e1 e2 e3 c1 c3, simp)
       by (smt Divides.mod_less le_imp_less_Suc le_mod_geq mod_Suc nat.distinct(1) nat.inject neq0_conv not_less test5)
     next
      fix s
      have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
            by blast
      show " scalar2Bool (J LAST ''le'' [J LAST ''+'' [s (Ident ''head''), index (Suc 0)], index LAST])"
        apply(cut_tac b1,auto) done
     next
      fix s
        show "J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] =
         expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) i) s"
         by (simp add: applyIPlusIsPlusI)
    qed
    }
   ultimately have "?P e " by satx
   }

     moreover
    {assume b1:"\<exists>i.  1\<le>i \<and> i\<le> LAST \<and> e=Edge  ( Vertex (2*i + 4)) ( Vertex (2*i+2 ))   " (is "\<exists>i. ?Q i")
      from b1 obtain i where b1:"?Q i" by blast

      have b3:"varOfExp (applyPlusN head i) =[Ident ''head'']"
        by simp
      have "i=LAST \<or> i <LAST" by(cut_tac b1 ,auto)
      moreover
      {assume b4:"i =LAST"
      have "?P e "
      proof(cut_tac  a b1  b3 b4,auto simp add:  assms Let_def)
        fix s

        assume c1:" J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)] =
        J LAST ''+'' [s (Ident ''head''), index (Suc 0)]" and
        c2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])"
        have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
        then obtain j where e1:"((s (Ident ''head'') ) = (index j))"
            by blast
        have e2:"j\<le> LAST"
          using  c2 e1 axiomOnLe  apply auto        done thm  onApplyPlusI
        have e3:"J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)]= index j"
          by (metis c2 e1 iPlusSucLatIsi)

        have e4:"J LAST ''+'' [s (Ident ''head''), index (Suc 0)] = index ((j +1) mod Suc LAST) "
          by (simp add: e1)
        show False
          apply(cut_tac c1 e3 e4 a, simp)
          by (metis e1 iPlus1IsNotI)
      next
        fix s
        show "  J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)] =
          expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) LAST) s"
          using applyIPlusIsPlusI by auto
      next
        fix s

          have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
            by blast
          show "scalar2Bool (J LAST ''le'' [J LAST ''+'' [s (Ident ''head''), index (Suc 0)], index LAST])"
          apply(cut_tac b1,auto) done
      next
        fix s
        assume
          a2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])" and
          a4:"expEval (J LAST) (caseExp (map (\<lambda>i. (eqn (applyPlusN head LAST) (Const (index i)), IVar (Para mem i))) (down LAST))) s =
         index data"
          have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
          using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
          by blast
          have b2:"j\<le> LAST"
          using  a2 b1 axiomOnLe  apply auto        done
          (*have a0:"s (Ident ''tail'') = s (Ident ''head'')"*)
          have b20:"tautlogy (eqn (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (LAST - Suc 0))
                              (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (LAST - Suc 0))) (J LAST)"
                  apply(induct_tac LAST, auto) done
          have b3:"
          expEval (J LAST)
          (substExp
            (caseExp
              (map (\<lambda>i. (eqn (applyPlusN head (LAST - Suc 0)) (Const (index i)), IVar (Para mem i))) (down LAST)))
            [(Ident ''head'', uif ''+'' [head, Const (index (Suc 0))])])
          s   =
           expEval (J LAST)
          (caseExp
            (map (\<lambda>i. (eqn (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (LAST - Suc 0)) (Const (index i)), IVar (Para mem i)))
            (down LAST))) s"
            using substCaseExp1 by auto

         have b4:" expEval (J LAST)
          ((caseExp (map (\<lambda>i. (eqn (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (LAST - Suc 0)) (Const (index i)),
          IVar (Para mem i))) (down LAST)))
            )
          s =
         expEval (J LAST) (caseExp (map (\<lambda>i. (eqn (applyPlusN head LAST) (Const (index i)), IVar (Para mem i))) (down LAST))) s"
         proof(rule caseExpCong1,simp)

            have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
            then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
              by blast
            have b2:"j\<le> LAST"
            using  a2 b1 axiomOnLe  apply auto        done
            show "expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (LAST - Suc 0)) s
            = expEval (J LAST) (applyPlusN head LAST) s"
            apply(cut_tac a b1 b2,auto) done
          qed

          show "expEval (J LAST)
          (substExp (caseExp (map (\<lambda>i. (eqn (applyPlusN head (LAST - Suc 0)) (Const (index i)), IVar (Para mem i))) (down LAST)))
            [(Ident ''head'', uif ''+'' [head, Const (index (Suc 0))])])
          s =
         index data"
         by (simp add: a4 b3 b4)

      qed
     }
    moreover
    {assume b4:"i <LAST"
      have "?P e "
      proof(cut_tac  a b1  b3 b4,auto simp add:  assms Let_def)
      fix s
      have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
            by blast
      show "scalar2Bool (J LAST ''le'' [J LAST ''+'' [s (Ident ''head''), index (Suc 0)], index LAST])"
        apply(cut_tac b1,auto) done

     next
      fix s
      assume c1:" J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] =
      J LAST ''+'' [s (Ident ''head''), index (Suc 0)]" and
      c2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])" and c3:"Suc 0 \<le> i"
       have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
          then obtain j where e1:"((s (Ident ''head'') ) = (index j))"
            by blast
        have e2:"j\<le> LAST"
          using  c2 e1 axiomOnLe  apply auto        done thm  onApplyPlusI
        have e3:"expEval (J LAST) (applyPlusN head i) s= index ((j +i) mod Suc LAST)"
          by (simp add: e1 e2 b4 less_imp_le_nat)

        show False
       apply(cut_tac a b1 e1 e2 e3 c1 c3, simp)
       by (smt Divides.mod_less le_imp_less_Suc le_mod_geq mod_Suc nat.distinct(1) nat.inject neq0_conv not_less test5)
     next
      fix s
      assume d1:"i <LAST" and d2:"Suc 0 \<le> i"
        show "J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] =
         expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) i) s"
         by (simp add: applyIPlusIsPlusI)
      next
       fix s
        assume
          a1:"Suc 0 \<le> i" and
          a2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])" and
          a4:"expEval (J LAST) (caseExp (map (\<lambda>ia. (eqn (applyPlusN head i) (Const (index ia)), IVar (Para mem ia))) (down LAST))) s =
         index data"
          have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
          using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
          by blast
          have b2:"j\<le> LAST"
          using  a2 b1 axiomOnLe  apply auto        done
          (*have a0:"s (Ident ''tail'') = s (Ident ''head'')"*)
          have b20:"tautlogy (eqn (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (LAST - Suc 0))
                              (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (LAST - Suc 0))) (J LAST)"
                  apply(induct_tac LAST, auto) done
          have b3:"
          expEval (J LAST)
          (substExp
            (caseExp
              (map (\<lambda>ia. (eqn (applyPlusN head (i - Suc 0)) (Const (index ia)), IVar (Para mem ia))) (down LAST)))
            [(Ident ''head'', uif ''+'' [head, Const (index (Suc 0))])])
          s   =
           expEval (J LAST)
          (caseExp
            (map (\<lambda>ia. (eqn (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (i - Suc 0)) (Const (index ia)), IVar (Para mem ia)))
            (down LAST))) s"
            using substCaseExp1 by auto

         have c4:" expEval (J LAST)
          ((caseExp (map (\<lambda>ia. (eqn (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (i - Suc 0)) (Const (index ia)),
          IVar (Para mem ia))) (down LAST)))
            )
          s =
         expEval (J LAST) (caseExp (map (\<lambda>ia. (eqn (applyPlusN head i) (Const (index ia)), IVar (Para mem ia))) (down LAST))) s"
         proof(rule caseExpCong1,simp)

            have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
            then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
              by blast
            have b2:"j\<le> LAST"
            using  a2 b1 axiomOnLe  apply auto        done
            show "expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (i - Suc 0)) s
            = expEval (J LAST) (applyPlusN head i) s"
            apply(cut_tac a b1 b2 b4 a1,auto)
            done
          qed

          show "expEval (J LAST)
          (substExp (caseExp (map (\<lambda>ia. (eqn (applyPlusN head (i - Suc 0)) (Const (index ia)), IVar (Para mem ia))) (down LAST)))
            [(Ident ''head'', uif ''+'' [head, Const (index (Suc 0))])])
          s =
         index data"
         by (simp add: a4 b3 c4)

      qed
    }
    ultimately have "?P e" by satx
    }
    moreover
    {assume b1:"e=Edge (Vertex 4) ( Vertex 1)"
     have "?P e"
     proof(cut_tac a b1, simp add:antOfRbFifo_def Let_def,auto)
     fix s
     assume c2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])"
       have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
          then obtain j where e1:"((s (Ident ''head'') ) = (index j))"
            by blast
        have e2:"j\<le> LAST"
         using  c2 e1 axiomOnLe  apply auto        done
        show " scalar2Bool (J LAST ''le'' [J LAST ''+'' [s (Ident ''head''), index (Suc 0)], index LAST]) "
        apply(cut_tac e1 e2,auto) done
     qed
     }
ultimately show "?P e" by satx
qed
lemma testAux[simp]:

shows "(expEval I e s =index i \<longrightarrow>
i \<le> LAST\<longrightarrow>expEval I (caseExp ((map (\<lambda>i. (eqn e (Const (index i)), me i)) (down LAST)@S))) s
=expEval  I  (me i) s) \<and>
(expEval I e s =index i \<longrightarrow>
 LAST < i\<longrightarrow>expEval I (caseExp ((map (\<lambda>i. (eqn e (Const (index i)),me i)) (down LAST)@S))) s
=expEval  I  (caseExp S) s)"  (is "?P LAST")
proof(induct_tac LAST,auto )qed

lemma test[simp]:
shows "(expEval I e s =index i \<longrightarrow>
i \<le> LAST\<longrightarrow>expEval I (caseExp ((map (\<lambda>i. (eqn e (Const (index i)), me i)) (down LAST)))) s
=expEval  I  (me i) s)"
proof -
have a:"(expEval I e s =index i \<longrightarrow>
i \<le> LAST\<longrightarrow>expEval I (caseExp ((map (\<lambda>i. (eqn e (Const (index i)), me i)) (down LAST)@[]))) s
=expEval  I  (me i) s)"
apply(cut_tac testAux  [where I="I" and S="[]" and i="i" and e="e" and s="s" and LAST="LAST" and me="me"])
apply simp
done
then show ?thesis by auto
qed

lemma instImply:
assumes a:"G=(rbFifoGsteSpec LAST  data)"   and c:"tag=tagFunOfRingBufFifo  data LAST"
shows
"\<forall> e. e \<in>edgesOf G\<longrightarrow>
tautlogy (implyForm (andForm (antOf G e) (andListForm (tag (source e)))) (consOf G e)) I"
proof(rule allI,rule impI,simp,rule allI,rule impI)
  fix e s
  assume a1:"e \<in> edgesOf G " and a2:"
           formEval I (antOf G e) s \<and> formEval I (andListForm (tag (source e))) s"
  let ?P ="\<lambda>e. formEval I (consOf G e) s"
  have "e=Edge vertexI ( Vertex 1) |
          e=Edge  ( Vertex 1) ( Vertex 3) |
          e=Edge  ( Vertex 1) ( Vertex 4)|
           (\<exists>i. 0\<le>i \<and> i\<le> LAST+1 \<and>  e=( Edge (Vertex ( 2*i+1 ))  (Vertex (  2*i+1 ))) )   |
            (\<exists>i. 1\<le>i \<and> i\<le> LAST+1 \<and>  e=( Edge (Vertex ( 2*i+2 ))  (Vertex (  2*i+2 ))) ) |

           (\<exists>i. 1\<le>i \<and> i\<le> LAST  \<and> e=( Edge (Vertex (2 * i + 1))  (Vertex (2 * i + 3))) ) |
           (\<exists>i. 1\<le>i \<and> i\<le> LAST  \<and> e=( Edge (Vertex (2 * i + 1))  (Vertex (2 * i + 4))) )  |

           (\<exists>i. 0\<le>i \<and> i\<le> LAST  \<and>  e= ( Edge (Vertex (2 * i + 3))  (Vertex (2 * i + 1))) ) |
           (\<exists>i. 1\<le>i \<and> i\<le> LAST   \<and> e=( Edge (Vertex(2 * i + 4))  (Vertex(2 *i+ 2))))|
           e=Edge (Vertex 4) (Vertex 1)"
      apply(cut_tac a a1,auto)  done

    moreover
    {assume b1:"e=Edge vertexI ( Vertex 1)"
     have "?P e"
     apply(cut_tac a b1, simp add:antOfRbFifo_def) done
     }
    moreover
    {assume b1:" (\<exists>i. 0\<le>i \<and> i\<le> LAST +1  \<and>  e=( Edge (Vertex (2* i + 1))  (Vertex (  2*i + 1))) )  " (is "\<exists>i. ?asm i")
     from b1 obtain i where b2:"?asm i" by auto
      have "?P e"
       apply(cut_tac a  c a2 b2, auto) done
    }
    moreover
    {assume b1:" (\<exists>i. 1\<le>i \<and> i\<le> LAST+1  \<and>  e=( Edge (Vertex (2* i + 2))  (Vertex (  2*i + 2))) )  " (is "\<exists>i. ?asm i")
     from b1 obtain i where b2:"?asm i" by auto
      have "?P e"
       apply(cut_tac  a  c a2 b2,auto) done
    }
     moreover
    {assume b1:" e=Edge  ( Vertex 1) ( Vertex 3) "

       have "?P e"
        apply(cut_tac a  c a2 b1,auto ) done
    }

     moreover
    {assume b1:" e=Edge  ( Vertex 1) ( Vertex 4) "
      let ?f="andForm (neg (eqn rst HIGH)) (andForm (eqn push HIGH) (neg (eqn tail (Const (index LAST )))) ) "

       have "?P e "
        apply(cut_tac a a1 a2 b1 ,auto simp add: antOfRbFifo_def assms) done
    }

    moreover
    {assume b1:" \<exists>i. 1\<le>i \<and> i\<le> LAST \<and> e=Edge  ( Vertex (2*i + 1)) ( Vertex (2*i + 3))"     (is "\<exists>i. ?Q i")
      from b1 obtain i where b1:"?Q i" by blast
      have "?P e "
        by(cut_tac  a  c a2 b1 ,auto simp add: antOfRbFifo_def assms )
     }

    moreover
    {assume b1:" \<exists>i. 1\<le>i \<and> i\<le> LAST \<and> e=Edge  ( Vertex (2*i + 1)) ( Vertex (2*i+4))    "(is "\<exists>i. ?Q i")
      from b1 obtain i where b1:"?Q i" by blast
      have "?P e "
        by(cut_tac a b1 a1 a2,auto simp add: antOfRbFifo_def assms)
     }

     moreover
    {assume b1:"\<exists>i. 0\<le>i \<and> i\<le> LAST \<and>  e=Edge  ( Vertex (2*i + 3)) ( Vertex (2*i + 1))   " (is "\<exists>i. ?Q i")
       from b1 obtain i where b1:"?Q i" by blast
       have "?P e "
        by(cut_tac   a  c a2 b1 ,auto simp add:Let_def antOfRbFifo_def assms )
     }

     moreover
    {assume b1:"\<exists>i.  1\<le>i \<and> i\<le> LAST \<and> e=Edge  ( Vertex (2*i + 4)) ( Vertex (2*i +2))   " (is "\<exists>i. ?Q i")
      from b1 obtain i where b1:"?Q i" by blast
      have "?P e "
         by(cut_tac  a   a2 b1 ,auto simp add: Let_def antOfRbFifo_def assms)

     }
    moreover
    {assume b1:"e=Edge (Vertex 4) ( Vertex 1)"
     have "?P e"
     apply(cut_tac  a  c a2 b1 ,case_tac "LAST=0",auto  simp add: Let_def antOfRbFifo_def assms) done
     }
    ultimately show "?P e" by satx
  qed

lemma main:
assumes a:"G=(rbFifoGsteSpec LAST  data)"
and c:"tag=tagFunOfRingBufFifo  data LAST" and
d:"M=(ringBuffifo  LAST )"
shows " circuitSatGsteSpec M G (J LAST) "
proof(rule mainLemma)
have a1:"consistent' (ringBuffifo LAST ) (J LAST) (rbFifoGsteSpec LAST  data) (tagFunOfRingBufFifo  data LAST)"
   apply (case_tac "LAST=0",rule consistencyOfRbfifo0,simp)
   apply(rule   consistencyOfRbfifo,arith) done
from a c d this show "consistent' M   (J LAST) G tag"
  by simp
next
from a  c show "\<forall>e. e \<in> edgesOf G \<longrightarrow>
        tautlogy (implyForm (andForm (antOf G e) (andListForm (tag (source e)))) (consOf G e)) (J LAST)"
apply(rule instImply) done
next
from a c show "tag (initOf G) = []"
apply auto done
qed
end