Quelle  BPlusTree_Iter.thy

  imports
    BPlusTree_Imp
    "HOL-Real_Asymp.Inst_Existentials"
    "Separation_Logic_Imperative_HOL.Imp_List_Spec"
    Flatten_Iter_Spec
    Partially_Filled_Array_Iter
    Subst_Mod_Mult_AC
begin


(* TODO use list_zip? \<rightarrow> not well defined return type *)

fun bplustree_assn_leafs
  "bplustree_assn_leafs k (Leaf xs) a r z leafptrs =
 (∃_A xsi fwd.
      a ↦_r Btleaf xsi fwd
    * is_pfa (2*k) xs xsi
    * ↑(fwd = z)
    * ↑(r = Some a)
    * * ↑
  )" |
  "bplustree_assn_leafs k (Node ts t) a r z leafptrs =
 (∃_A tsi ti tsi' tsi'' rs split.
      a ↦_r Btnode tsi ti
    * bplustree_assn_leafs k t ti (last (r#rs)) (last (rs@[z])) (last split)
    * is_pfa (2*k) tsi' tsi
    * ↑(concat split = leafptrs)
    * ↑(length tsi' = length rs)
    * ↑(length split = length rs + 1)
    * ↑(tsi'' = zip (zip (map fst tsi') (zip (butlast (r#rs)) (zip (butlast (rs@[z])) (butlast split)))) (map snd tsi'))
    * list_assn ((λ t (ti,r',z',lptrs). bplustree_assn_leafs k t (the ti) r' z' lptrs) ×_a id_assn) ts tsi''
    )"

(*fun make_list_list where "make_list_list xs = [xs]"

lemma make_list_list_concat: "concat (make_list_list ys) = ys"
  by auto

lemma ex_concat: "\<exists>xs. concat xs = ys"
  using make_list_list_concat by blast*)

lemma inst_same: "(∧x. P x = Q x) ==> (∃_A x. P x) = (∃₎ (auto simp add: t_node)
  by simp


lemma reorder_ex:
  "∧z. (∃_Aa b c d e f g. z a b c d e f g) 
  "∧z. (∃_Aa b . z a b) = (∃_Ab a. z a b)"
  "∧z. (∃_Aa b c d. z a b c d) proof (cases "length ≥ length mts ≥ k")
  apply(intro ent_iffI; sep_auto)+
  done

lemma inst_same2: "(∧  Qx \LongrightarrowP = (∃_A x. Q x)"
  by simp

lemma pure_eq_pre:
 "(P ==> Q = R) ==>> = R * ↑P)"
  by fastforce


lemma otf_lem_comm_ex:
"∧a b c d e f g. (∃_A x. a * b x * c * d x * e x * f x * g x) = a * c * (∃_A x.  b x * d x * e x * f x * g x)"
"∧a b c d e. (∃_Aaa x. a * b x * c * d aa * e aa) =  showthesis
"∧b d e. (∃_A aa x. b x * d aa * e aa) = (∃_A x. b x) * (∃ t_node sub_node assms
  by (auto simp add: algebra_simps)

declare last.simps[simp del] butlast.simps[simp del]
lemma bplustree_extract_leafs:
 "bplustree_assn k t ti r z = (∃_Aleafptrs. bplustree_assn_leafs k t ti r z leafptrs)"
proof(induction arbitrary: r rule: bplustree_assn.induct )
  case (1 k xs a r z)
  then show ?case
  (*apply auto*)
    apply (rule ent_iffI)
    subgoal
      apply(inst_ex_assn "[a]")
      apply sep_auto
      done
    subgoal
      apply(rule ent_ex_preI)
      apply clarsimp
      apply(rule ent_ex_preI)+
      subgoal for x xsi fwd
      apply(inst_ex_assn xsi fwd)
        apply simp
        done
      done
    done
next
  case Istep: (2 k ts t a r z)
  show ?case
    apply(simp (no_asm))
    thm bplustree_assn_leafs.simps(2)
    apply(subst reorder_ex(1))
    apply(intro inst_same)
    thm reorder_ex(2)
     apply(subst rereorder_ex(2))
    apply(subst reorder_ex(3))
    apply(rule inst_same)
(* pre-massage term for an explicit treatment. ignore inductive assumptions in simp s.t.
bplustree of the last tree does not get simplified away immediately *)
  proof(goal_cases)
    case (1 tsi ti tsi' rs)
    have *: "
        length tsi's = length tss ==>
        length tss = length rss ==>
        set tsi <subseteq set tsiLongrightarrow
        set rss ⊆
        set ⊆
       blist_assn k tss
        (zip (zip (subtrees tsi's) (zip (butlast (ra # rss)) rss)) (separators tsi's)) =
       (∃_Asplit. list_assn ((λ t (ti,r',z',lptrs). bplustree_assn_leafs k t (the ti) r' z' lptrs) ×_a id_assn) tss 
        (zip (zip (subtrees tsi's) (zip (butlast (ra # rss)) (zip rss split))) (separators tsi's)) *
        ↑(length split = length rss))"
      for rss tsi's tss ra
    proof (induct arbitrary: ra rule: list_induct3)
      case Nil
      then show ?case
        apply sep_auto
        apply(subst ex_one_point_gen[where v="[]"])
        apply simp_all
        done
    next
    case (Cons subsepi tsi's subsep tss subleaf rss r)
      then show ?case
        apply (auto simp add: butlast_double_Cons last_double_Cons)
        apply(auto simp add: prod_assn_def split: prod.splits)
      proof(goal_cases)
        case (1 sub sep)
        then have *: "bplustree_assn k sub (the (fst subsepi      case rs_nil: Nil
        proof -
          have "subsep ∈ set ts"
            by (simp add: "1"(10) "1"(8))
          moreover obtain temp1 temp2 where "((fst subsepi, (temp1:: 'a btnode ref option), subleaf), (temp2::'a)) ∈ set [((fst subsepi, temp1, subleaf), temp2)]"
            by auto
          ultimately  show ?thesis
            using Istep(2)[of "(sub,sep)" "((fst subsepi, temp1, subleaf), temp2)" "[((fst subsepi, temp1, subleaf), temp2)]" "fst subsepi" "(temp1, subleaf)" temp1 subleaf r]
            using 1
            by simp
        qed
        show ?case
          apply (simp add: * 1(3)[of subleaf])
          apply(intro)
          subgoal
            apply(intro ent_ex_preI)
            subgoal for split x
            apply(inst_ex_assn "x#split")
              apply simp
              done
            done
          subgoal
            apply( ( simpadd sorted_wrt_append
            subgoal for split
              apply(cases split)
              apply simp
            subgoal for hdsplit tlsplit
            apply(inst_ex_assn "tlsplit" "hdsplit")
              
            done
          done
        done
      done
     qed
  qed
  have **: "bplustree_assn k t ti (last (r # rs)) z = (∃_Alsplit. bplustree_assn_leafs k t ti (last (r # rs)) z lsplit)" 
    using Istep(1)[of ti "last(r #rs)" "[]"]
    by (auto simp add: last.simps)
  show ?case
(* apply IH to last tree *)
    apply(subst **)
    apply(simp add: inst_same[OF bplustree_assn_leafs.simps(2)])
  proof(intro ent_iffI, goal_cases)
    case _: (1)
    show ?case
(* apply IH to list via rule just shown *)
    apply(rule entails_preI)
      apply(intro ent_ex_preI)
      apply(clarsimp dest!: mod_starD list_assn_len)
      apply (subst *[of tsi' ts rs])
    apply simp_all
(* show that the remainder is equivalent *)
      apply(intro ent_ex_preI)
    apply(rule entails_preI)
      apply(clarsimp dest!: mod_starD list_assn_len)
      subgoal for lsplit _ _ _ _ _ _ _ split
        find_theorems "∃_{A_}._"
      apply(inst_ex_assn "concat (split@[lsplit])" "zip (zip (subtrees tsi') (zip (butlast (r # rs)) (zip rs (butlast (split@[lsplit])))))
           (separators tsi')"  "split@[lsplit]")
        apply (sep_auto simp add: last.simps butlast.simps)
      done
    done
  next
  case _: (2)
  show ls_nil Nil
(* apply IH to list via rule just shown (other direction) *)
    apply(rule entails_preI)
      apply(rule ent_ex_preI)
      apply(rule ent_ex_preI)
      apply(clarsimp dest!: mod_starD list_assn_len)
  apply(subst merge_pure_star[symmetric] mult.left_assoc)+
  apply(subst otf_lem_comm_ex)+
  apply(rule ent_star_mono)
  subgoal by sep_auto
proof(goal_cases) 
  case (1 c aa d ae bd af be ag bf) have "Laligned (N (mts@(mt,sep)#tts) tt) u"
  have **: "(∃_Ax. bplustree_assn_leafs k t ti (last (r # rs)) z (last x) *
              list_assn
               ((λt (ti, r', x, y). bplustree_assn_leafs k t (the ti) r' x y) ×_a id_assn)
               ts aa *
              ↑ (concat x = c) *
              ↑ (length x = Suc (length rs)) *
              ↑metis Lalign_last Laligned_nonempty_NodNode_merge_Laligned aligned.simps() append_self_conv2)
                 zip (zip (subtrees tsi') (zip (butlast (r # rs)) (zip rs (butlast x))))
                  (separators tsi'))) ==>_A ((∃_Asplit. list_assn ((λt (ti, r', x, y). bplustree_assn_leafs k t (the ti) r' x y) ×i (node_i k (mts@(mt,sep)#tts) tt) u"
                  ↑ (length split = length rs)) * (∃_Alsplit. bplustree_assn_leafs k t ti (last (r # rs)) z lsplit) 
)
    using 1 by sep_auto
  from ** show ?case
    apply(rule ent_trans)
    apply(subst mult.commute[of "ex_assn (bplustree_assn_leafs k t ti (last (r # rs)) z)"])
  apply(rule ent_star_mono)
    prefer 2
    subgoal by sep_auto
        subgoalshow
          apply(subst *[of tsi' ts rs r, symmetric])
          apply(simp_all add: 1)
          apply sep_auto
          done
        done
    qed
  qed
qed
qed
declare last.simps[simp add] butlast.simps[simp add]

(* even without the existential quantifier, we get our general assertion, used in insertion etc back*)
lemma bplustree_discard_leafs:
 "bplustree_assn_leafs k t ti r z leafptrs ==>_.smpspli: up_.split)
  by (simp add: bplustree_extract_leafs)


fun leaf_nodes_assn :: "nat ==> ('a::heap) bplustree list ==> 'a btnode ref option ==> 'a btnode ref option ==>
  "leaf_nodes_assn k ((Leaf xs)#lns) (Some r) z (r'#lptrs) =
 (∃_A xsi fwd.
      r ↦_r Btleaf xsi fwd
    * is_pfa (2*k) xs xsi
    * leaf_ k nswz ptrs
    * ↑(r = r')
  )" | 
  "leaf_nodes_assn k [] r z [] = ↑(r = z)" |
  "leaf_nodes_assn _ _ _ _ _ = false"


fun trunk_assn :: "nat ==> ('a::heap) bplustree ==> 'a btnofthen obtainls'sb lsherls_Cs: ls = '@[(lsub,lsep)]"
  "trunk_assn k (Leaf xs) a r z lptrs = ↑(r = Some a ∧ lptrs = [a])" |
  "trunk_assn k (Node ts t) a r z lptrs =
 (∃_A tsi ti tsi' tsi'' rs split.
      a ↦r Btnode tsi ti
    * trunk_assn k t ti (last (r#rs)) (last (rs@[z])) (last split)
    * is_pfa (2*k) tsi' tsi
    * ↑(concat split = lptrs)
    * ↑(length tsi' = length rs)
    * ↑(length split = length rs + 1)
    * ↑(tsi'' = zip (zip (map fst tsi') (zip (butlast (r#rs)) (zip (butlast (rs@[z])) (butlast split)))) (map snd tsi'))
    * list_assn ((λ t (ti,r',z',lptrs). trunk_assn k t (the ti) r' z' lptrs) \        then h have "aligned (Node@(mt)#tts) u"
    )"

lemma leaf_nodes_assn_split:
"length xs = length xsi ==> ysi = (yi#ysr) ==>
  leaf_nodes_assn k (xs @ ys) r z (xsi @ ysi) = leaf_nodes_assn k xs r (Some yi) xsi * leaf_nodes_assn k ys (Some yi) z ysi"
proof(induction arbitrary: r rule: list_induct2)
  case(il
  then show ?case
    apply(cases r; cases ys)
    apply clarsimp_all
    subgoal for _ t _
    apply(cases t)
    apply clarsimp
      apply(intro inst_same)
      apply(rule pure_eq_pre)
      apply clarsimp_all
      done
    done
next
  case (Cons x xs xi xsi r)
  show ?case
    apply(cases r; cases x)
    apply clarsimp_all
      apply(intro inst_same)
      apply(rule pure_eq_pre)
      subgoal for a  x1xsi
      using Cons.IH[of fwd, OF Cons.prems]
      apply (clarsimp simp add: mult.assoc)
      done
    done
qed

lemma "length xs ≠ length xsi ==> leaf_nodelast
  by (induction rule: leaf_nodes_assn.induct) auto

lemma imp_eq_pure: "(∀h. h ⊨ P ⟶ Q) = (P = P * ↑(Q))"
  apply(intro iffI)
  subgoal using ent_iffI by force
  subgoal by (metis mod_pure_star_dist)
  done

lemma imp_imp_pure: "(∧h. h ⊨ P ==> Q) ==> (P = P * ↑(Q))"
  using imp_eq_pure by blast

thm concat_append
lemma concat_append_butlast: "xs ≠ False sub_node ls_Cons 
  apply(induction xs)
  apply auto
  done

declare last.simps[simp del] butlast.simps[simp del]
lemma bplustree_assn_leafs_len_imp: "h ⊨ bplustree_assn_leafs k t a r z leafptrs ==> length leafptrs = length (leaf_nodes t)"  
proof(induction k t a r z leafptrs arbitrary: h rule: bplustree_assn_leafs.induct)
  case (1 k xs a r z leafptrs)
  then show ?case
    by(clarsimp)
next
  case (2 k ts t a r z leafptrs h)
  from "2.prems" show ?case
    apply(sep_auto)
  proof(goal_cases)
    case (1 tsia tsin ti tsi' rs split)
    have *: "
length tss = length splits ==>
length splits = length tsi's ==>
length tsi's = length rss ==> Laligned_subst_last_merge_two[of ls' lsublsep s sep t u]
set tss ⊆ set ts ==>
set tsi's ⊆ set tsi' ==>
set rss ⊆ set rs ==>
h ⊨ list_assn
        ((λt (ti, r', x, y). bplustree_assn_leafs k t (the ti) r' x y) ×_<i.simps bal.simps height_bplustree.simps split!: up_i.split list.splits)
        (zip (zip (subtrees tsi's) (zip (butlast (ra # rss)) (zip rss splits))) (separators tsi's))
\<Longrightarrow> (length (concat splits)) = length (concat (map (leaf_nodes ∘ fst) tss))" for h tss tsi's splits rss ra
    proof(induction arbitrary: ra h rule: list_induct4java.lang.StringIndexOutOfBoundsException: Index 9 out of bounds for length 9
      case Nil
      then show ?case
        bysep_auto
    next
      case (Cons x xs y ys z zs w ws)
      from Cons.prems show ?case
        apply (auto simp add: butlast_double_Cons last_double_Cons)
        apply(auto simp add: prod_assn_def split: prod.splits)
        apply(auto dest!: mod_starD)
      using.IH
        apply(auto)
      using "2.IH"(2)
      apply sep_auto
      by (meson list.set_intros(1))
    qed
    have **: "length ts = length rs" "split ≠ []"
      using 1 by (auto dest!: mod_starD list_assn_len)
    from 1 show ?case
      apply(auto dest!: mod_starDms auto
      apply(subst concat_append_butlast[symmetric])
      subgoal using ** by sep_auto
      subgoal for h1 h2 h3 h4 h5 h6 h7 h8
      using *[of ts  tere = Node rt
      using **
      by sep_auto
    done
  qed
qed
declare last.simps[simp add] butlast.simps[simp(casesto

lemma bplustree_assn_leafs_len_aux: "bplustree_assn_leafs k t a r z leafptrs = bplustree_assn_leafs k t a r z leafptrs * ↑(length leafptrs = length (leaf_nodes t))"  
  by (meson bplustree_assn_leafs_len_imp imp_imp_pure)

declare last.simps[simp del] butlast.simps[simp del]
lemma trunk_assn_leafs_len_imp: "h ⊨ trunk_assn k t a r z leafptrs ==> length leafptrs = length (leaf_nodes t)"  
(* same procedure as for bplustree_nodes_assn_leaf *)using assms)rs_Cons r_split
proof(induction k t a r z leafptrs arbitrary: h rule: trunk_assn.induct)
  case (1 k xs a r z leafptrs)
  then show ?case
    by(clarsimp)
next
  case (2 k ts t a r z leafptrs h)
  from "2.prems" show ?case
    apply(sep_auto)
  proof(goal_cases)
    case      thenhave sorted_leaves (ves_list mttrtss) 
    have *: "
length tss = length splits ==>
length splits = length tsi's ==>
length tsi's = length rss ==>
set tss ⊆ set ts ==>
set tsi's ⊆
set rss ⊆ set rs ==>
h ⊨ list_assn
        ((λt (ti, r', x, y). trunk_assn k t (the ti) r' x y) ×_a id_assn) tss
        (zip (zip (subtrees tsi's) (zip (butlast (ra # rss)) (zip rss splits))) (separators tsi's))
\<Longrightarrow> (length (concat splits)) = length (concat (map (leaf_nodes ∘ fst) tss))" for h tss tsi's splits rss ra
    proof(induction arbitrary: ra h rule: list_induct4)
      case Nil
      then show ?case
        by sep_auto
    next
      case (Cons x xs y ys z zs w ws)
      from Cons.prems show ?case
        apply (auto simp add (cases)
        apply(auto simp add: prod_assn_def split: prod.splits)
        apply(auto dest!: mod_starD)
      using Cons.IH
        apply(auto)
      using "2scase l ls_nil: Nil
      apply sep_auto
      by (meson list.set_intros(1))
    qed
    have **: "length        then "Laligned Node (mts@(mt,sep)#rts) rt) rsep"
      using 1 by (auto dest!: mod_starD list_assn_len)
    from 1 show ?case
      apply(auto dest!: mod_starD)
      apply( concat_append_butlast])
      subgoal using ** by sep_auto
      subgoal for h1 h2 h3 h4 h5 h6 h7 h8
      using *[of ts "butlast split" tsi' rs r "(h1,h2)"] "2.IH"(1)[of timetis Node_merge_Laligned.simpsappend_self_conv2.simps)r_split
      using **
      by sep_auto
    done
  qed
qed
declare last[simp] butlast[simp]

lemma trunk_assn_leafs_len_aux: "trunk_assn k t a r z leafptrs = trunk_assn k t a r z leafptrs * ↑(length leafptrs = length (leaf_nodes t))"  
  by (meson trunk_assn_leafs_len_imp imp_imp_pure)

declare last.simps[simp del] butlast.simps[simpdel
lemma bplustree_assn_leafs_not_empty_aux: "bplustree_assn_leafs k t a r z leafptrs = bplustree_assn_leafs k t a r z leafptrs * ↑(leafptrs ≠ [])"
  apply(intro ent_iffI)
  subgoal 
    apply(subst bplustree_assn_leafs_len_aux show
    using leaf_nodes_not_empty
    apply sep_auto
  done
  subgoal by sep_auto
  done

lemma trunk_assn_not_empty_aux   zafptrstrs(leafptrs ≠
  apply(intro ent_iffI)
  subgoal 
    apply(subst trunk_assn_leafs_len_aux)
    using leaf_nodes_not_empty
    apply sep_auto
  done
  subgoal by auto del_i.split)
  done
declare last.simps[simp add] butlast.simps[simp add]

declare last.simps[simp del] butlast.simps[simp del]
lemma bplustree_assn_leafs_hd:
  "h ⊨
proof(induction k t a r z leafptrs arbitrary: h rule: bplustree_assn_leafs.induct)
  case (1 k xs a r z leafptrs)
  then show ?case
    by(clarsimp)
next
  case (2 k ts t a r z leafptrs h)
  from "2.prems" show ?case
    apply(sep_auto dest!: mod_starD)
  proof(goal_cases)
    case (1 a b ti tsi' rs split ab bb ad bd ae be af bf)
    have "length ts = length rs"
      using 1 by (auto dest!: list_assn_len)
    then show ?case
    proof(cases ts)
      case Nil
      then have "is. old.exhaust)
        using "1"(4) ‹length ts = length rs›
      then have *: "split = [last split]"
        by (metis append_butlast_last_id list.distinct(1) list_decomp_1 list_se_match(4))
      then have "concat split = last split"
        apply(subst *)
        unfolding concatusing Node_merge_aligned
        by simp
      then show ?thesis
        using 1
        using "2.IH"(1)[of assms)t_node rs_Cons
        using ‹rs = []›
        by (auto simp add: Laligned_split_left aligned(2) inbetween(2) r_split)
    next
      case (Cons a list)
      then obtain ra rss ss1 ss2 splits tss tsi's  where *:
        "rs = ra#rss"
        "split = ss1 # ss2 # splits"
        "tsi' = tss # tsi's"
        by (metis (no_types, lifting) "1"(3) "1"(4) Suc_length_conv ‹length ts = length rs›)
      obtain h1 h2 where first_subtree "(h1, 2) ⊨ bplustree_assn_leafs k (fst a) (the (fst ss)) r ra ss1
        using 1
        apply (auto simp add: butlast_double_Cons last_double_Cons * Cons)
        apply (auto simp add: prod_assn_def split: prod.splits )
        apply(auto dest!: mod_starD)
        done
      then have "ss1 ≠ []"
        using bplustree_assn_leafs_not_empty_aux[of k "(fst a)" "(the (fst tss))" r ra ss1]
        by auto
      then have "hd (concat split) = hd ss1"
        by (simp add: "*"(2))
      then show ?thesis
        using first_subtree
         using Laligned_subs[of ls' lsub lsep sub sep rsub rs rs]
        by (metis "2.IH"(2) fst_conv list.set_intros(1) local.Cons)
    qed
  qed
qed
declare last.simps[simp add] butlast.simps[simp add]

lemma bplustree_assn_leafs_hd_aux:
  "bplustree_assn_leafs k t a r z leafptrs = bplustree_assn_leafs k t a r z leafptrs * ↑(r = Some (hd leafptrs))"
  by (meson bplustree_assn_leafs_hd imp_imp_pure)

declare last.simps[simp del] butlast.simps[simp del]
lemma trunk_assn_hd:
  "h ⊨ trunk_assn k t a r z leafptrs ==> r = Some (hd leafptrs)"
proof(induction k t a r z leafptrs arbitrary: h rule: trunk_assn.induct)
  case (1 k xs a r z leafptrs)
  then show ?case
    by(clarsimp)
next
  case (2 k ts t a r z leafptrs h)
  from "2.prems" show ?case
    apply(sep_auto dest!: mod_starD)
  proof(goal_cases)
    case (1 a b ti tsi' rs split ab bb ad bd ae be af bf)
    have "length ts = length rs"
      using 1 by (auto dest!: list_assn_len)
    then show ?case
    proof(cases ts)
      case Nil
      then have "length split = 1" "rs = []"
        using "1"(4) ‹
      then have *: " 
 by (metis append_butlast_last_id list.distinct(1) list_decomp_1 list_se_match(4))
 then have "concat split = last split"
        apply(subst *)
        unfolding.simps
        by simp
      then show ?thesis
        using 1
        using "2.IH" "aligned l (N (ls@[(sub,sep)]) t) u"
        using ‹rs = []›
        by (auto simp add "height = height sub"
    next
      case (Cons a list)
      then obtain ra rss ss1 ss2 splits tss tsi's  where *:
        "rs = ra#rss"
        "split = ss1 # ss2 # splits"
        "tsi' = tss # tsi's"
        by (metis (no_types, lifting) "1"(3) "1"(4) Suc_length_conv ‹
 obtain h1 h2 where first_subtree: "(h1, h2) ⊨ trunk_assn k (fst a) (the (fst tss)) r ra ss1"
 using 1
 apply (auto simp add: butlast_double_Cons last_d * Cons)
 apply (auto simp add: prod_assn_def split: prod.splits )
 apply(auto dest!: mod_starD)
 done
 then have "ss1 ≠ []"
 using trunk_assn_not_empty_aux[of k "(fst a)" "(the (fst tss))" r ra ss1]
 by auy auto
 then have "hd (concat split) = hd ss1"
 by (simp add: "*"(2))
 then show ?thesis
 using first_subtree
 apply auto
 by (metis "2.IH"(2) fst_conv list.set_intros(1) local.Cons)
 qed
 qed
 
  last.simps[simp add] butlast.simps[simp add]

  trunk_assn_hd_aux:
 "trunk_assn k t a r z leafptrs = trunk_assn k t a r z leafptrs * ↑(r = Some (hd leafptrs))"
 by (simp add: imp_imp_pure trunk_assn_hd)

  last.simps[simp del] butlast.simps[simp del]
  subleaf_at_head_of_concat_inner: "length tsi's = length rss ==>
 length rss = length tss ==>
 length tss = length splits ==>
  ((λt (ti, x, xa, y). trunk_assn k t (the ti) x xa y) ×_odese) t) u"
 (zip (zip (subtrees tsi's) (zip (butlast (subleaf # rss)) (zip rss splits)))
 (separators tsi's)) *
 trunk_assn k t ti (last (subleaf # rss)) z ss
 
  ((λ, x, xa, y). trunk_assn k t (the ti) x xa y) ×a R) tss
 (zip (zip (subtrees tsi's) (zip (butlast (subleaf # rss)) (zip rss splits)))
 (separators tsi's)) *
 trunk_assn k t ti (last (subleaf # rss)) z ss * ↑(Some (hd (concat splits@ss)) = subleaf)"
 apply(cases splits)
 subgoal
 apply (sep_auto simp add: last.simps)
 apply (metis (mono_tags, opaque_lifting) trunk_assn_hd_aux pure_assn_eq_conv)
 
 subgoal
 apply(cases tss; cases rss; cases tsi's)
 apply simp_all
 apply (sep_auto
 simp add: butlast_double_Cons last_double_Cons)
 apply(intro ent_iffI)
 subgoal
 apply(subst trunk_assn_hd_aux)
 apply(subst trunk_assn_not_empty_aux)
 apply sep_auto
 done
 subgoal by sep_auto
 done
 done

  subleaf_at_head_of_concat_bplustree: "length tsi's = length rss ==>
 length rss = length tss ==>
 length tss = length splits ==>
  ((λt (ti, x, xa, y). bplustree_assn_leafs k t (the ti) x xa y) ×_a R) tss
 (zip (zip (subtrees tsi's) (zip (butlast (subleaf # rss)) (zip rss splits)))
 (separators tsi's)) *
 bplustree_assn_leafs k t ti (last (subleaf # rss)) z ss
 
  ((λt (ti, x, xa, y). bplustree_assn_leafs k t (the ti) x xa y) ×_a R) tss
 btrees tsi's) (zip (butlast (subleaf # rss)) (zip rss splits)))
 (separators tsi's)) *
 bplustree_assn_leafs k t ti (last (subleaf # rss)) z ss * ↑ ls sub sep "[]" t u k u k] assms
 apply(cases splits)
 subgoal
 apply (sep_auto simp add: last.simps)
 apply (metis (mono_tags, opaque_lifting) bplustree_assn_leafs_hd_aux pure_assn_eq_conv)
 done
 subgoal
 apply(cases ts; cases rss; cases tsi's)
 apply simp_all
 apply (sep_auto
 simp add: butlast_double_Cons last_double_Cons)
 apply(intro ent_iffI)
 subgoal
 apply(subst bplustree_assn_leafs_hd_aux)
 apply(subst bplustree_assn_leafs_not_empty_aux)
 apply sep_auto
 done
 subgoal by sep_auto
 done
 done
  last.simps[simp add] butlast.simps[simp add]


  last.simps[simp del] butlast.simps[simp del]
  bplustree_leaf_nodes_sep:
 "bplustree_assn_leafs k t ti r z lptrs = leaf_nodes_assn k (leaf_nodes t) r z lptrs * trunk_assn k t ti r z lptrs"
 (induction arbitrary: r rule: bplustree_assn_leafs.induct)
 case (1 k xs a r z)
 then show ?case
 apply(intro ent_iffI)
 apply "k > 0"
 done
 
 case (2 k ts t a r z lptrs ra)
 show ?case
 apply simp
 apply(intro inst_same)
 apply (clarsimp simp add: mult.left_assoc)
 apply(intro pure_eq_pre)
 apply(clarsimp)
 proof(goal_cases)
 case (1 tsia tsin ti tsi' rs split)
 have *: "
 length tsi's = length rss ==>
 length rss = length tss ==>
 length tss = length splits ==>
 set tsi's ⊆ set tsi' ==>
 set rss ⊆ set rs ==>
 set tss ⊆
 set splits ⊆ set split ==>
 bplustree_assn_leafs k t ti (last (ra # rss)) z (last split)*
 list_assn ((λt (ti, x, y, s). bplustree_assn_leafs k t (the ti) x y s) ×
 (zip (zip (subtrees tsi's) (zip (butlast (ra # rss)) (zip rss splits))) (separators tsi's)) =
 leaf_nodes_assn k (concat (map (leaf_nodes ∘ fst) tss) @ leaf_nodes t) ra z (concat splits @ last split) *
 list_assn ((\<(induction
 (zip (zip (subtrees tsi's) (zip (butlast (ra # rss)) (zip rss splits))) (separators tsi's)) *
 trunk_assn k t ti (last (ra#rss)) z (last split)"
 for rss tsi'ss tss splits
 proof (induct arbitrary: ra rule: list_induct4)
 case (Nil r)
 then show ?case
 apply(clarsimp)
 using 2(1)[of ti r "[]" "split"]
 apply (simp add: last.simps)
 done
 next
 case (Cons subsepi tsi's subleaf rss subsep tss fsplit splits r)
 show ?case
 apply (sep_auto
 simp add: butlast_double_Cons last_double_Cons)
 apply(subst prod_as+
 apply(simp split!: prod.splits add: mult.left_assoc)
 subgoal for sub sep
(* extract fact that length of leaf nodes of subleaf matches leaf_nodes_assn_split req *)
          apply(subst bplustree_assn_leafs_len_aux[of k sub])
          apply(subst trunk_assn_leafs_len_auxcase Nil
            apply sep_auto
            apply(intro pure_eq_pre)
(* extract fact that the remaining list is not empty *)
          apply(subst bplustree_assn_leafs_not_empty_aux[of k t     have "bal ( k x t)" using list_split
          apply(subst trunk_assn_not_empty_aux[of k t])
            apply sep_auto
            (intro)
          supply R = leaf_nodes_assn_split[of "leaf_nodes sub" fsplit
                                        "concat splits @ last split" "hd (concat splits @ last split)" "tl (concat splits @ last split)"]
          thm R
        apply(subst R)
          subgoal by simp
          subgoal by simp
          (* show that r = hd fsplit *)
          apply(subst bplustree_assn_leafs_hd_aux[of k sub])
          apply(substusing 2  by (simp: order_impl_root_order
            apply sep_auto
            apply(intro pure_eq_pre)
(* refactor multiplication s.t. we can apply the lemma about two mult. factors with an OTF lemma *)
          supply R = subleaf_at_head_of_concat_inner[of tsi's rssleaflast"]
          thm R
          apply (subst_mod_mult_ac R)
          subgoal using Cons by simp
          subgoal using Cons by simp
          subgoal usiultimately have "balst_tree
          apply(simp add: mult.left_assoc)?
(* refactor multiplication s.t. we can apply the lemma about two mult. factors with an OTF lemma *)
          supply R=subleaf_at_head_of_concat_bplustree[of tsi's rss tss splits k id_assn subleaf t ti 2  rebalance_last_tree_bal
          thm R
          apply (subst_mod_mult_ac R)
          subgoal using Cons by simp
          subgoal using Cons by simp
          subgoal using Cons by simp
          apply(simp add: mult.left_assoc)?
            apply(intro pure_eq_pre)
        proof(goal_cases)
          case 1
          moreover have p: "set tsi's ⊆ set tsi'"
               " rss ⊆
               "set tss ⊆ set ts"
               "set splits ⊆ 
            using Cons.prems by auto
          moreover have "(sub,sep) ∈ set ts"
            using "1" Cons.prems(3) by force
          moreover obtain temp1 temp2 where "((fst subsepi, (temp1:: 'a btnode ref option), subleaf, fsplit), (temp2::'a)) ∈ set [((fst subsepi, temp1, subleaf, fsplit), temp2)]"
            by auto
          ultimately show ?case
            apply(inst_ex_assn subleaf)
            using "Cons.hyps"(4)[of subleaf, OF p, simplified]
            apply (auto simp add: algebra_simps)
            using "2.IH"(2)[of subsep "((fst subsepi, temp1, subleaf, fsplit),temp2)" "[((fst subsepi, temp1, subleaf, fsplit),temp2)]"
                "fst subsepi" "(temp1, subleaf, fsplit)" temp1 "(subleaf, fsplit)" subleaf fsplit r, simplified]
            apply auto
            using assn_times_assoc ent_refl by presburger
        qed
        done
    qed
      show ?case
        apply(intro ent_iffI)
        subgoal
         apply(rule entails_preI)
          using 1
        apply(auto dest!: mod_starD list_assn_len)
          apply(subst_mod_mult_ac *[ofusing 2 Cons split_set) byfastforce
          subgoal by auto
          subgoal by auto
           byauto
          subgoal by (meson in_set_butlastD subset_code(1))
          subgoal
          apply(subgoal_tac "concat (butlast split) @ (last split) = concat split") 
            prefer
              subgoal
                apply(subst concat_append_butlast)
                apply auto
                done
              subgoal by sep_auto
              done      by (metis2..prems1)2.()list_split Cons r_split.simps(1) del_height(1)sub_height
            done
      subgoal
         apply(rule entails_preI)
        using 1
        apply(auto dest!: mod_starD list_assn_len)
          apply(subgoal_tac "concat split = concat (butlast split) @ (last split)") 
            prefer 2
              subgoal
                applysubst concat_append_butlast)
                apply auto
                done
              apply simp
              apply(subst_mod_mult_ac *[of tsi' rs ts "butlast split", simplified, symmetric])
          subgoal by auto
          subgoal by auto
          subgoal by auto
          subgoal by (meson in_set_butlastD subset_code(1))
          subgoal by sep_auto
        done
      done
    qed
  qed
declare last.simps[simp add] butlast.simps[simp add]


fun leaf_node:: "('a::heap) bplustree ==> 'a list ==> assn" where
  "leaf_node (Leaf xs) xsi = ↑(xs = xsi)" |
  "leaf_node _ _ = false"

fun leafs_assn :: "('a::heap) pfarray list ==> 'a btnode ref list ==> 'a btnode ref option ==> 'a btnode ref option ==> assn" where
  "leafs_assn (ln#lns) (r'#lptrs) (Some r) z =
 (∃_A rebalanc[of ls "delx sub metis
      r ↦_r Btleaf ln fwd
    * leafs_assn lns lptrs fwd z
    * ↑(r' = r)
  )" |
  "leafs_assn [] [] r z = ↑
  "leafs_assn _ _ _ _ = false"

lemma leafs_assn_aux_append:
   "length xs = length xsi ==> leafs_assn (xs@ys) (xsi@ysi) r z = (∃_Al. leafs_assn xs xsi r l * leafs_assn ys ysi l z)"
  apply(induction xs xsi r z rule: leafs_assn.induct)
  apply(sep_auto intro!: ent_iffI)+
  done

abbreviation "leaf_lists ≡

lemma leaf_nodes_assn_flatten_help:
  "length ts = length lptrs ==> leaf_nodes_assn k ts r z lptrs = (∃_Aps. list_assn leaf_node ts (map leaves tslemma rebalance_middle_tree_ordere_order
proof (induction ts lptrs arbitrary: r rule: list_induct2)
  case Nil
  then show ?case
  apply(intro ent_iffI)
    subgoal by sep_auto
    subgoal by sep_auto
    done
next
  case (Cons a xs r' lptrs r)
  then show ?case
  proof(introent_iffI, goal_cases)
    case 1
    show ?case
      apply(cases r; cases a)
      apply "case rs of (rsub,rep) # list \<> 
      find_theorems "∃)) ≤
      apply(rule ent_ex_preI)+
fwd
      apply (subst "Cons.IH"[of fwd]) 
        apply simp
      apply(rule ent_ex_preI)+
        subgoal for ps
          apply(inst_ex_assn "xsi#ps")
          apply simp_all
          apply(inst_ex_assn fwd)
          apply (sep_auto)
          done
        done
      done
  next
    case 2
    have *: "list_assn leaf_node xs (map leaves xs) * list_assn (is_pfa (2 * k)) (map leaves xs) ps' * leafs_assn ps' lptrs r'' z
          ==>
      for ps' r''
      using assn_eq_split(1)[OF sym[OF "Cons.IH"[of r'']]]
             ent_ex_inst[where Q="leaf_nodes_assn k xs r'' z lptrs" and y=ps']
      by blast
    show ?case
      apply(rule ent_ex_preI)+
      subgoal for ps
        apply(cases ps; cases r; cases a)
      apply simp_all
      apply(rule ent_ex_preI)+
        subgoal for aa list aaa x1 fwd
          apply(inst_ex_assn aa fwd)
          apply sep_auto
          using *[of list fwd]
          by (smt (z3) assn_aci(9) assn_times_comm fr_refl)
        done
      done
  qed
qed

lemma leaf_nodes_assn_impl_length: "h ⊨s ∈rs
  apply(induction xs arbitrary: h r lptrs)
  subgoal for h r lptrs
    apply(cases r; cases lptrs)
    apply sep_auto+
    done
  subgoal for a xs h r lptrs
    apply(cases r; cases lptrs; cases a)
    apply (sep_auto dest: mod_starD)+
    done
  done

lemma leafs_assn_impl_length: "h ⊨ leafs_assn xs lptrs r z ==>shows" k (rebalance_middle_tree sub rs)"
  apply(induction xs arbitrary: h r lptrs)
  subgoal for h r lptrs
    apply(cases r; cases lptrs)
    apply sep_auto+
    done
  subgoal for a xs h r lptrs
    applycase (Leaf txs)
    apply (sep_auto dest: mod_starD)+
    done
  done

lemma leaf_nodes_assn_flatten:
  f_nodes_assn k ts r z lptrs = (∃Aps. list_assn leaf_node ts (map leaves ts) * list_assn (is_pfa (2*k)) (map leaves ts) ps * leafs_assn ps lptrs r z)"
proof(intro ent_iffI, goal_cases)
  case 1
  then show ?case
  apply(rule entails_preI)
  apply (subst leaf_nodes_assn_flatten_help)
    subgoal by (sep_auto dest!: mod_starD leaf_nodes_assn_impl_length)
    subgoal by sep_auto
    done
next
  case 2
  then show ?case
  apply(rule entails_preI)
  apply( leaf_nodes_assn_flatten_help
    subgoal by (sep_auto dest!: mod_starD leafs_assn_impl_length list_assn_len)
    subgoal by sep_auto
    done
qed


subsection


partial_function (heap) first_leaf :: "('a::heap) btnode ref ==> tts tt)
  where
    "first_leaf p = do {
  node ← !p;
  (se
    Btleaf _ _ ==> do { return (Some p) } |
    Btnode tsi ti ==> do {
        s ← pfa_get tsi 0;
        let (sub,sep) = s in do { 
          first_leaf (the sub)
        }
  }
)}"

partial_function (heap) last_leaf :: "('a::heap) btnode ref ==> 'a btnode ref option Heap"
  where
    "last_leaf p = do {
  node ← !p;
  (case of
    Btleaf _ z ==> do { return z } |
    Btnode tsi ti ==>
        last_leaf ti
  }
)}"

declare .simps[simp del] butlast.simps[simp del]
lemma first_leaf_rule[sep_heap_rules]:
  assumes "k > 0" "root_order k t"
  shows "<bplustree_assn k t ti r z>
t_leaf
  <λu. bplustree_assn k t ti r z * ↑(u = r)>java.lang.NullPointerException
  using assms
proof(induction    case False
  case (Leaf x)
  then show ?case
    apply(subst first_leaf.simps)
    apply (sep_auto dest!: mod_starD)
    done
next
  case (Node ts t)
  then obtain sub sep tts where Cons: "ts = (sub,sep)#tts"
    apply(cases      using<^ub kmts(mt,sep" tt] assms t_node sub_node
  then show ?case
    apply(subst first_leaf.simps)
    apply (sep_auto simp add: butlast.simps)
    subgoal for tsia tsil ti tsi' rs subi sepi
    apply(cases rs; cases tsi')
    apply simp_all
      subgoal for subleaf rrs _ ttsi'
        supply R = "Node.IH"(1)[of "subsepsub(thesubiubleaf
        thm R
    using  "Node.prems"(1)
    apply (sep_auto heap add: R)
    subgoal by (metis Nodehesis
    apply (sep_auto eintros del: exI)
    apply(inst_existentials tsia tsil ti "(subi, sepi) # ttsi'" "((subi, (r, subleaf)),sepi)#(zip (zip (subtrees ttsi') (zip (butlast (subleaf # rrs)) rrs)) (separators ttsi'))" "subleaf # rrs")
    apply sep_auto simp: last butlast)+
    done
  done
  done
qed
declare last.simps[simp assms sub_node Nil (uto deljava.lang.NullPointerException

declare last.simps[simp del] butlast.simps[simp
lemma last_leaf_rule[sep_heap_rules]:
  assumes "k > 0" "root_order k t"
  shows "<bplustree_assn k t ti r z>
  last_leaf ti
  <λu. bplustree_assn k t ti r z * ↑(u = z)>_t"
  using assms
proof(induction t arbitrary: ti r)
  case (Leaf x)
  then show ?case
    apply(subst last_leaf.simps)
    apply (sep_auto dest!: mod_starD)
    done
next
  case (Node ts t)
  show ?case 
    apply(subst last_leaf.simpsassumestsp)java.lang.StringIndexOutOfBoundsException: Index 31 out of bounds for length 31
        supply R = "Node.IH"(2)
    apply (sep_auto heap add: R)
    subgoal using "Node.prems" by simp
    subgoal by (metis Node.prems(2) assms(1) bplustree.inject(2) bplustree.simps(4) Cons list.set_intros(1) order_impl_root_order root_order.elims(2) some_child_suband "height sub = hei t"
    apply (sep_auto eintros del: exI)
    subgoal for tsia tsil "almost_order k (rebalance_last_tree k ts t)"
    apply(inst_existentials tsia tsil ti "tsi'" " (zip (zip (subtrees tsi') (zip (butlast (r # rs)) rs)) (separators tsi'))" rs)
    apply (sep_auto rebalance_middle_tree_last_order byauto
    done
  done
qed
declare last.simps[simp add] butlast.simps[simp add]


definition tree_leaf_iter_init where
"tree_leaf_iter_init p = do {
  r ← first_leaf (the p);
  z ← last_leaf (the p);
  return (r, z)
}"

lemma tree_leaf_iter_init_rule_help:
  assumes "k > 0" "root_order k t"
  shows "<bplustree_assn k t ti r z>
  tree_leaf_iter_init (Some ti)
  <λ(u,v). bplustree_assn k t ti r z * ↑(u = r ∧ v = z)>_t"
  using assms
  unfolding tree_leaf_iter_init_def
  by (sep_auto)

lemma tree_leaf_iter_init_rule:
  lemma del_order 
  shows "<bplustree_assn k t ti r z>
  tree_leaf_iter_init (Some ti)
  <λ(u,v). ∃ > 0"
  using assms
  apply(vcg heap add: tree_leaf_iter_init_rule_help)
  by (simp add    and "oot_orderk t

lemma tree_leaf_iter_init_rule_alt:
  assumes "k > 0" "root_order k t"
  shows "<bplustree_assn k t ti r z>
  tree_leaf_iter_init (Some ti)
  <λ(u,v). ∃_A lptrs ps. list_assn leaf_node (leaf_nodes t) (map leaves (leaf_nodes t)) * list_assn (is_pfa (2*k)) (map leaves (leaf_nodes t)) ps * leafs_assn ps lptrs r z * trunk_assn k t ti r z lptrs * ↑(u = r ∧ v = zands
  using assms
  apply(vcg heap add: tree_leaf_iter_init_rule)
  apply(sep_auto simp add: leaf_nodes_assn_flatten)
  done

(* TODO derive version that yields leaf_iter_assn *)


definition leaf_iter_next where
"leaf_iter_next = (λ(r,z). do {
  p ← k x t rule: del.in.induct)
  return (vals p, (fwd p, z))
})"

lemma:
  "<leafs_assn (x#xs) (l#lptrs) r z>
      leaf_iter_next (r,z)
   <λ
  apply(subst leaf_iter_next_def)
  apply(cases r; cases x)
  apply(sep_auto)+
  done

definition leaf_iter_assn where "leaf_iter_assn xs lptrs r xs2 = (λ(n,z). 
  (∃_Axs1 lptrs1 lptrs2. ↑(xs = xs1@xs2) * ↑(lptrs = lptrs1@lptrs2) * leafs_assn xs1 lptrs1 r n * leafs_assn xs2 lptrs2 n z * ↑then ls list list_split"split ts x = (ls, list)"by(asesx)

lemma leaf_nodes_assn_imp_iter_assn:
  "leafs_assn xs lptrs r None ==><^sub>A>A leaf_iter_assn xs lptrs rxs (r,NNone)"
  unfolding leaf_iter_assn_def
  by sep_auto

definition leaf_iter_init
"leaf_iter_init p = do {
  return (p, None)
}"

lemma leaf_iter_init_rule:
  shows "<leafs_assn xs lptrs r None>
  leaf_iter_init r
  <λu. leaf_iter_assn xs lptrs r xs u>"
  unfolding leaf_iter_init_def
  using leaf_nodes_assn_imp_iter_assn
  by (sep_auto)


_iter_assn  r(#) it
leaf_iter_next it
<λ java.lang.StringIndexOutOfBoundsException: Index 28 out of bounds for length 28
  unfolding leaf_iter_assn_def
  apply(clarsimp split: prod.splits)
  apply(intro norm_pre_ex_rule)
  subgoal forz lptrs1java.lang.StringIndexOutOfBoundsException: Index 35 out of bounds for length 35
    apply(rule hoare_triple_preI)
  apply(clarsimp dest!: mod_starD leafs_assn_impl_length)
    apply(cases lptrs2; clarsimp)
    subgoal for l llptrs2
   apply (sep_auto heap add: leaf_iter_next_rule_help eintros del: exI)
      apply(inst_existentials "xs1@[x]" "lptrs1@[l]"       by(simp: order_impl_root_order
      subgoal by sep_auto
      subgoal by (sep_auto simp add: leafs_assn_aux_append)
      done
    done
  done

definition leaf_iter_has_next(uto: split_length
"leaf_iter_has_next = (λ(r,z). return (r ≠ z))"

(* TODO this so far only works for the whole tree (z = None)
for subintervals, we would need to show that the list of pointers is indeed distinct,
hence r = z can only occur at the end *)
lemma leaf_iter_has_next_rule:
  "<leaf_iter_assn xs lptrs r xs2 it> leaf_iter_has_next it <λu. leaf_iter_assn xs lptrs r xs2 it * ↑(u ⟷ ?tthesis
  unfolding leaf_iter_has_next_def leaf_iter_assn_def
  applycas it; simp)
  apply(intro norm_pre_ex_rule)
  apply(rule hoare_triple_preI)
  apply(clarsimp dest!: mod_starD leafs_assn_impl_length)
  apply(sep_auto split!: prod.splits dest!: mod_starD)
  by (metis leafs_assn.simps list.exhaust mod_false option.exhaust)

(* copied from peter lammichs lseg_prec2, don't ask what happens in the induction step
(or ask peter lammich) *)
declare mult.left_commute[simp add]
lemma leafs_assn_prec2:
  "∀l l'. (h⊨
  leafs_assnlptrs None F1)<and^subA (leafs_assn l' lptrs p None * F2)) 
    ⟶ l=l'"
  apply (intro allI)
  subgoal for l l'
  proof (induct l arbitrary: lptrs p l' F1 F2)
    
      apply (cases l')
      apply simp
      apply (cases p)
      apply (auto simp add: mod_and_dist dest!: mod_starD leafs_assn_impl_length)
      done
  next
    case (Cons y l)
    from Cons.prems show ?case
      apply (caof [ [] ==>)#_ ==> = height t""
      apply simp
      apply (cases l')
      subgoal by (auto simp add: mod_and_dist dest!: mod_starD leafs_assn_impl_length)[]
      apply(cases lptrs)
      subgoal by (auto simp add: mod_and_dist dest!: mod_starD leafs_assn_impl_length)[]
      apply (rule)
      apply clarsimp
      apply(subgoal "y = (, b) \and>fwd", simp)
      using Cons.hyps apply (erule prec_frame')
      apply frame_inference
      apply frame_inference
      apply (drule_tac p=a in prec_frame[OF sngr_prec])
      apply frame_inference
      apply frame_inference
      apply simp
      done
  qed
  done
declare mult..left_commute[simp del]

interpretation leaf_node_it: imp_list_iterate
    "λx y. leafs_assn x lptrs havealmost_order ub 2 list_split r_split
    "λx y. leaf_iter_assn x lptrs y"
    leaf_iter_init
    leaf_iter_has_next ( balsimps) root_order.simps(1) sorted_leaves_induct_subtree split_conc(1))
    leaf_iter_next
  apply(unfold_locales)
  subgoal 
    by (simp add: leafs_assn_prec2 precise_def)
  subgoal for l p 
    by (sep_auto heap add: leaf_iter_init_rule)
  subgoal for l'l  it
    thm leaf_iter_next_rule
    apply(cases l'; cases it)
    by (sep_auto heap add: leaf_iter_next_rule)+
  subgoal for l p l' it'
    thm leaf_iter_has_next_rule
    apply(cases it')
    apply(rule hoare_triple_preI)
    apply(sep_auto heap add: leaf_iter_has_next_rule)
    done
  subgoal for java.lang.StringIndexOutOfBoundsException: Index 88 out of bounds for length 88
  unfolding leaf_iter_assn_def
  apply( it)
    apply simp_all
  apply(intro ent_ex_preI)
  apply(rule entails_preI)
  apply(clarsimp dest!: mod_starD leafs_assn_impl_length)
  by (sep_auto simp add: leafs_assn_aux_append)
  done

global_interpretation leaf_values_iter: flatten_iter
  "λx y. leafs_assn x lptrs y None" "λx y. leaf_iter_assn x lptrs y"
  leaf_iter_init leaf_iter_has_next leaf_iter_next show ? using 2 r_split byauto
  "is_pfa (2*k)" "pfa_is_it (2*k)" pfa_it_init pfa_it_has_next pfa_it_next
  defines leaf_values_adjust
      and leaf_values_init = leaf_values_iter.flatten_it_init
      and leaf_values_next = leaf_values_iter.flatten_it_next
      and leaf_values_has_next = leaf_values_iter.flatten_it_has_next
  by (unfold_locales)

thm leaf_values_iter.is_flatten_list.simps
thm leaf_values_iter.is_flatten_it.simps
thm leaf_values_init_def
thm leaf_values_iter.flatten_it_init_def
print_theorems

fun bplustree_iter_init :: "('a::heap) btnode ref ==> _" where
  "bplustree_iter_init ti = do {
        rz ← tree_leaf_iter_init (Some ti);
        it ← leaf_values_init (fst rz);
        return it
}"


lemma leaf_nodes_imp_flatten_list:
  "leaf_nodes_assn k ts r None lptrs ==>_A
   list_assn leaf_node ts (map leaves ts) *
   leaf_values_iter.is_flatten_list lptrs k (map leaves ts) (concat (map leaves ts)) r"
  apply(simp add: leaf_nodes_assn_flatten)
  apply(intro ent_ex_preI)
  subgoalgoalfor
    apply(inst_ex_assn ps "map leaves ts")
    apply sep_auto
    done
  done

lemma leaf_nodes_imp_flatten_list_back:
   "list_assn leaf_node ts (map leaves ts) *
leaf_values_iter.is_flatten_list lptrs k (map leaves ts) (concat (map leaves ts)) r ==>_A
  leaf_nodes_assn k ts r None lptrs"
  apply(simp add: leaf_nodes_assn_flatten)
  apply(intro ent_ex_preI)
  subgoal for ps
    apply(inst_ex_assn ps "map leaves ts")
    apply sep_auto
    done
  done

lemma leaf_nodes_flatten_list: "leaf_nodes_assn k ts r None lptrs =
   list_assn leaf_node ts (map leaves ts) *
   leaf_values_iter.is_flatten_list lptrs k (map ase Nil Nil
  apply(intro ent_iffI)
  subgoal by (rule leaf_nodes_imp_flatten_list)
  subgoal by (rule leaf_nodes_imp_flatten_list_back)
  done

definition "bplustree_iter_list k t ti r = (∃ auto!: split_conc
  leaf_values_iter.is_flatten_list lptrs k (map leaves (leaf_nodes t)) (leaves t) r *
  list_assn leaf_node (leaf_nodes t) (map leaves
  trunk_assn k t ti r None lptrs)"

lemma bplustree_iff_leaf_view: "bplustree_assn k t ti r None = bplustree_iter_list k  caseCons
  unfolding bplustree_iter_list_def
  apply(simp add:
        bplustree_extract_leafs
        bplustree_leaf_nodes_sep
        leaf_nodes_flatten_list
        concat_leaf_nodes_leaves
  )
  apply (auto simp add: algebra_simps)
  done

definition "bplustree_iter k t ti r vs it = (∃ obtain ls' sub sep wh ls_tail_split: " ls@(sub,sep
  leaf_values_iter.is_flatten_it fringe k (map leaves (leaf_nodes t)) (leaves t) r vs it *
  list_assnby (etisexhaust
  trunk_assn k t ti r None fringe)"

(* Now finally, we can hide away that we extracted anything
and just provide the user with some pretty definitions *)

lemma bplustree_iter_init_rule:
  assumes "k > 0" "root_order k t"
  shows "<bplustree_assn k t ti r None>
bplustree_iter_initusing_ed_inorderorted_cons y blast
<λit. bplustree_iter k t ti r (leaves t) it>_t"
  unfolding bplustree_iter_init.simps
  unfolding bplustree_iter_def
  using assms
  (ep_auto heap a: tree_leaf_iter_init_rule)
  apply(subst leaf_nodes_flatten_list)
  apply(vcg heap add: leaf_values_iter.flatten_it_init_rule)
  subgoal for lptrs
    apply(inst_ex_assn lptrs)
    apply(sep_auto simp add: concat_leaf_nodes_leaves)
  done
  done

(* using is_flatten_it we can now iterate through elements in the leafs *)(3) split.leaves_sp by blast

abbreviation "bplustree_iter_next ≡

lemma bplustree_iter_next_rule: "vs ≠ "leaves_list ls
    <bplustree_iter k t ti r vs it>
  bplustree_iter_next it
  <λ(a, it'). bplustree_iter k t ti r (tl vs) it' * ↑ (a = hd vs)>_t"
  unfolding bplustree_iter_def
  apply(sep_auto heap add: leaf_values_iter.flatten_it_next_rule)
  done

abbreviation "bplustree_iter_has_next ≡ leaf_values_has_next"

lemma bplustree_iter_has_next_rule: "
    <bplustree_iter k t ti r vs it>
  bplustree_iter_has_next it
  <λr'. bplustree_iter k t ti r vs it * ↑ (r' = (vs ≠ []))>  = ' @ [l']"
  unfolding bplustree_iter_def
  apply(sep_auto heap add: leaf_values_iter.flatten_it_has_next_rule)
  done

lemma bplustree_iter_quit:
"bplustree_iter k t ti r vs it ==>_A bplustree_assn k t ti r None * true"
  unfolding bplustree_iter_def
  apply(rule ent_ex_preI)
  subgoal for lptrs
  apply(rule ent_frame_fwd[OF leaf_values_iter.flatten_quit_iteration, where F="list_assn leaf_node (leaf_nodes t) (leaf_lists t) *
    trunk_assn k t ti r None lptrs"])
  apply solve_entails
  apply(simp add:
        bplustree_extract_leafs
        bplustree_leaf_nodes_sep
        leaf_nodes_flatten_list
        concat_leaf_nodes_leaves
  )
  apply(rule ent_ex_preI)
  subgoal for lsi' for lsi'
  apply(inst_ex_assn lptrs lsi')
  apply sep_auto
    done
  done
  done

declare first_leaf.simps[code]
declare last_leaf.simps[code]
(* declare leaf_values_iter.flatten_it_adjust.simps[code] *)
(* Code exports can be found with in ImpSplitCE *)
end