Theory Earley_Recognizer

theory Earley_Recognizer
  imports
    Earley_Fixpoint
begin

section ‹Earley recognizer›

subsection ‹List auxilaries›

fun filter_with_index' :: "nat  ('a  bool)  'a list  ('a × nat) list" where
  "filter_with_index' _ _ [] = []"
| "filter_with_index' i P (x#xs) = (
    if P x then (x,i) # filter_with_index' (i+1) P xs
    else filter_with_index' (i+1) P xs)"

definition filter_with_index :: "('a  bool)  'a list  ('a × nat) list" where
  "filter_with_index P xs = filter_with_index' 0 P xs"

lemma filter_with_index'_P:
  "(x, n)  set (filter_with_index' i P xs)  P x"
  by (induction xs arbitrary: i) (auto split: if_splits)

lemma filter_with_index_P:
  "(x, n)  set (filter_with_index P xs)  P x"
  by (metis filter_with_index'_P filter_with_index_def)

lemma filter_with_index'_cong_filter:
  "map fst (filter_with_index' i P xs) = filter P xs"
  by (induction xs arbitrary: i) auto

lemma filter_with_index_cong_filter:
  "map fst (filter_with_index P xs) = filter P xs"
  by (simp add: filter_with_index'_cong_filter filter_with_index_def)

lemma size_index_filter_with_index':
  "(x, n)  set (filter_with_index' i P xs)  n  i"
  by (induction xs arbitrary: i) (auto simp: Suc_leD split: if_splits)

lemma index_filter_with_index'_lt_length:
  "(x, n)  set (filter_with_index' i P xs)  n-i < length xs"
  by (induction xs arbitrary: i)(auto simp: less_Suc_eq_0_disj split: if_splits; metis Suc_diff_Suc leI)+

lemma index_filter_with_index_lt_length:
  "(x, n)  set (filter_with_index P xs)  n < length xs"
  by (metis filter_with_index_def index_filter_with_index'_lt_length minus_nat.diff_0)

lemma filter_with_index'_nth:
  "(x, n)  set (filter_with_index' i P xs)  xs ! (n-i) = x"
proof (induction xs arbitrary: i)
  case (Cons y xs)
  show ?case
  proof (cases "x = y")
    case True
    thus ?thesis
      using Cons by (auto simp: nth_Cons' split: if_splits)
  next
    case False
    hence "(x, n)  set (filter_with_index' (i+1) P xs)"
      using Cons.prems by (cases xs) (auto split: if_splits)
    hence "n  i + 1" "xs ! (n - i - 1) = x"
      by (auto simp: size_index_filter_with_index' Cons.IH)
    thus ?thesis
      by simp
  qed
qed simp

lemma filter_with_index_nth:
  "(x, n)  set (filter_with_index P xs)  xs ! n = x"
  by (metis diff_zero filter_with_index'_nth filter_with_index_def)

lemma filter_with_index_nonempty:
  "x  set xs  P x  filter_with_index P xs  []"
  by (metis filter_empty_conv filter_with_index_cong_filter list.map(1))

lemma filter_with_index'_Ex_first:
  "(x i xs'. filter_with_index' n P xs = (x, i)#xs')  (x  set xs. P x)"
  by (induction xs arbitrary: n) auto

lemma filter_with_index_Ex_first:
  "(x i xs'. filter_with_index P xs = (x, i)#xs')  (x  set xs. P x)"
  using filter_with_index'_Ex_first filter_with_index_def by metis


subsection ‹Definitions›

datatype pointer =
  Null
  | Pre nat ―‹pre›
  | PreRed "nat × nat × nat" "(nat × nat × nat) list" ―‹k', pre, red›

type_synonym 'a bin = "('a item × pointer) list"
type_synonym 'a bins = "'a bin list"

definition items :: "'a bin  'a item list" where
  "items b  map fst b"

definition pointers :: "'a bin  pointer list" where
  "pointers b  map snd b"

definition bins_eq_items :: "'a bins  'a bins  bool" where
  "bins_eq_items bs0 bs1  map items bs0 = map items bs1"

definition bins :: "'a bins  'a item set" where
  "bins bs   { set (items (bs!k)) | k. k < length bs }"

definition bin_upto :: "'a bin  nat  'a item set" where
  "bin_upto b i  { items b ! j | j. j < i  j < length (items b) }"

definition bins_upto :: "'a bins  nat  nat  'a item set" where
  "bins_upto bs k i   { set (items (bs ! l)) | l. l < k }  bin_upto (bs ! k) i"

definition wf_bin_items :: "'a cfg  'a list  nat  'a item list  bool" where
  "wf_bin_items 𝒢 ω k xs  x  set xs. wf_item 𝒢 ω x  end_item x = k"

definition wf_bin :: "'a cfg  'a list  nat  'a bin  bool" where
  "wf_bin 𝒢 ω k b  distinct (items b)  wf_bin_items 𝒢 ω k (items b)"

definition wf_bins :: "'a cfg  'a list  'a bins  bool" where
  "wf_bins 𝒢 ω bs  k < length bs. wf_bin 𝒢 ω k (bs!k)"

definition ε_free :: "'a cfg  bool" where
  "ε_free 𝒢 = (r  set ( 𝒢). rhs_rule r  [])"

definition nonempty_derives :: "'a cfg  bool" where
  "nonempty_derives 𝒢  s. ¬ 𝒢  [s] * []"

definition InitL :: "'a cfg  'a list  'a bins" where
  "InitL 𝒢 ω 
    let rs = filter (λr. lhs_rule r = 𝔖 𝒢) (remdups ( 𝒢)) in
    let b0 = map (λr. (init_item r 0, Null)) rs in
    let bs = replicate (length ω + 1) ([]) in
    bs[0 := b0]"

definition ScanL :: "nat  'a list  'a  'a item  nat  ('a item × pointer) list" where
  "ScanL k ω a x pre 
    if ω!k = a then
      let x' = inc_item x (k+1) in
      [(x', Pre pre)]
    else []"

definition PredictL :: "nat  'a cfg  'a  ('a item × pointer) list" where
  "PredictL k 𝒢 X 
    let rs = filter (λr. lhs_rule r = X) ( 𝒢) in
    map (λr. (init_item r k, Null)) rs"

definition CompleteL :: "nat  'a item  'a bins  nat  ('a item × pointer) list" where
  "CompleteL k y bs red 
    let orig = bs ! (start_item y) in
    let is = filter_with_index (λx. next_symbol x = Some (lhs_item y)) (items orig) in
    map (λ(x, pre). (inc_item x k, PreRed (start_item y, pre, red) [])) is"

fun upd_bin :: "'a item × pointer  'a bin  'a bin" where
  "upd_bin e' [] = [e']"
| "upd_bin e' (e#es) = (
    case (e', e) of
      ((x, PreRed px xs), (y, PreRed py ys)) 
        if x = y then (x, PreRed py (px#xs@ys)) # es
        else e # upd_bin e' es
      | _ 
        if fst e' = fst e then e # es
        else e # upd_bin e' es)"

fun upds_bin :: "('a item × pointer) list  'a bin  'a bin" where
  "upds_bin [] b = b"
| "upds_bin (e#es) b = upds_bin es (upd_bin e b)"

definition upd_bins :: "'a bins  nat  ('a item × pointer) list  'a bins" where
  "upd_bins bs k es  bs[k := upds_bin es (bs!k)]"

partial_function (tailrec) EarleyL_bin' :: "nat  'a cfg  'a list  'a bins  nat  'a bins" where
  "EarleyL_bin' k 𝒢 ω bs i = (
    if i  length (items (bs ! k)) then bs
    else
      let x = items (bs!k) ! i in
      let bs' =
        case next_symbol x of
          Some a  (
            if a  nonterminals 𝒢 then
              if k < length ω then upd_bins bs (k+1) (ScanL k ω a x i)
              else bs
            else upd_bins bs k (PredictL k 𝒢 a))
        | None  upd_bins bs k (CompleteL k x bs i)
      in EarleyL_bin' k 𝒢 ω bs' (i+1))"

declare EarleyL_bin'.simps[code]

definition EarleyL_bin :: "nat  'a cfg  'a list  'a bins  'a bins" where
  "EarleyL_bin k 𝒢 ω bs = EarleyL_bin' k 𝒢 ω bs 0"

fun EarleyL_bins :: "nat  'a cfg  'a list  'a bins" where
  "EarleyL_bins 0 𝒢 ω = EarleyL_bin 0 𝒢 ω (InitL 𝒢 ω)"
| "EarleyL_bins (Suc n) 𝒢 ω = EarleyL_bin (Suc n) 𝒢 ω (EarleyL_bins n 𝒢 ω)"

definition EarleyL :: "'a cfg  'a list  'a bins" where
  "EarleyL 𝒢 ω  EarleyL_bins (length ω) 𝒢 ω"

definition recognizer :: "'a cfg  'a list  bool" where
  "recognizer 𝒢 ω = (x  set (items (EarleyL 𝒢 ω ! length ω)). is_finished 𝒢 ω x)"


subsection ‹Epsilon productions›

lemma ε_free_impl_non_empty_word_deriv:
  "ε_free 𝒢  a  []  ¬ Derivation 𝒢 a D []"
proof (induction "length D" arbitrary: a D rule: nat_less_induct)
  case 1
  show ?case
  proof (rule ccontr)
    assume assm: "¬ ¬ Derivation 𝒢 a D []"
    show False
    proof (cases "D = []")
      case True
      then show ?thesis
        using "1.prems"(2) assm by auto
    next
      case False
      then obtain d D' α where *:
        "D = d # D'" "Derives1 𝒢 a (fst d) (snd d) α" "Derivation 𝒢 α D' []" "snd d  set ( 𝒢)"
        using list.exhaust assm Derives1_def by (metis Derivation.simps(2))
      show ?thesis
      proof cases
        assume "α = []"
        thus ?thesis
          using *(2,4) Derives1_split ε_free_def rhs_rule_def "1.prems"(1) by (metis append_is_Nil_conv)
      next
        assume "¬ α = []"
        thus ?thesis
          using *(1,3) "1.hyps" "1.prems"(1) by auto
      qed
    qed
  qed
qed

lemma ε_free_impl_nonempty_derives:
  "ε_free 𝒢  nonempty_derives 𝒢"
  using ε_free_impl_non_empty_word_deriv derives_implies_Derivation nonempty_derives_def by (metis not_Cons_self2)

lemma nonempty_derives_impl_ε_free:
  assumes "nonempty_derives 𝒢"
  shows "ε_free 𝒢"
proof (rule ccontr)
  assume "¬ ε_free 𝒢"
  then obtain N α where *: "(N, α)  set ( 𝒢)" "rhs_rule (N, α) = []"
    unfolding ε_free_def by auto
  hence "𝒢  [N]  []"
    unfolding derives1_def rhs_rule_def by auto
  hence "𝒢  [N] * []"
    by auto
  thus False
    using assms(1) nonempty_derives_def by fast
qed

lemma nonempty_derives_iff_ε_free:
  shows "nonempty_derives 𝒢  ε_free 𝒢"
  using ε_free_impl_nonempty_derives nonempty_derives_impl_ε_free by blast


subsection ‹Bin lemmas›

lemma length_upd_bins[simp]:
  "length (upd_bins bs k es) = length bs"
  unfolding upd_bins_def by simp

lemma length_upd_bin:
  "length (upd_bin e b)  length b"
  by (induction e b rule: upd_bin.induct) (auto split: pointer.splits)

lemma length_upds_bin:
  "length (upds_bin es b)  length b"
  by (induction es arbitrary: b) (auto, meson le_trans length_upd_bin)

lemma length_nth_upd_bin_bins:
  "length (upd_bins bs k es ! n)  length (bs ! n)"
  unfolding upd_bins_def using length_upds_bin
  by (metis linorder_not_le list_update_beyond nth_list_update_eq nth_list_update_neq order_refl)

lemma nth_idem_upd_bins:
  "k  n  upd_bins bs k es ! n = bs ! n"
  unfolding upd_bins_def by simp

lemma items_nth_idem_upd_bin:
  "n < length b  items (upd_bin e b) ! n = items b ! n"
  by (induction b arbitrary: e n) (auto simp: items_def less_Suc_eq_0_disj split!: pointer.split)

lemma items_nth_idem_upds_bin:
  "n < length b  items (upds_bin es b) ! n = items b ! n"
  by (induction es arbitrary: b)
    (auto, metis items_nth_idem_upd_bin length_upd_bin order.strict_trans2)

lemma items_nth_idem_upd_bins:
  "n < length (bs ! k)  items (upd_bins bs k es ! k) ! n = items (bs ! k) ! n"
  unfolding upd_bins_def using items_nth_idem_upds_bin
  by (metis linorder_not_less list_update_beyond nth_list_update_eq)

lemma bin_upto_eq_set_items:
  "i  length b  bin_upto b i = set (items b)"
  by (auto simp: bin_upto_def items_def, metis fst_conv in_set_conv_nth nth_map order.strict_trans2)

lemma bins_upto_empty:
  "bins_upto bs 0 0 = {}"
  unfolding bins_upto_def bin_upto_def by simp

lemma set_items_upd_bin:
  "set (items (upd_bin e b)) = set (items b)  {fst e}"
proof (induction b arbitrary: e)
  case (Cons b bs)
  show ?case
  proof (cases "x xp xs y yp ys. e = (x, PreRed xp xs)  b = (y, PreRed yp ys)")
    case True
    then obtain x xp xs y yp ys where "e = (x, PreRed xp xs)" "b = (y, PreRed yp ys)"
      by blast
    thus ?thesis
      using Cons.IH by (auto simp: items_def)
  next
    case False
    then show ?thesis
    proof cases
      assume *: "fst e = fst b"
      hence "upd_bin e (b # bs) = b # bs"
        using False by (auto split: pointer.splits prod.split)
      thus ?thesis
        using * by (auto simp: items_def)
    next
      assume *: "¬ fst e = fst b"
      hence "upd_bin e (b # bs) = b # upd_bin e bs"
        using False by (auto split: pointer.splits prod.split)
      thus ?thesis
        using * Cons.IH by (auto simp: items_def)
    qed
  qed
qed (auto simp: items_def)

lemma set_items_upds_bin:
  "set (items (upds_bin es b)) = set (items b)  set (items es)"
  apply (induction es arbitrary: b)
      apply (auto simp: items_def)
  by (metis Domain.DomainI Domain_fst Un_insert_right fst_conv insert_iff items_def list.set_map set_items_upd_bin sup_bot.right_neutral)+

lemma bins_upd_bins:
  assumes "k < length bs"
  shows "bins (upd_bins bs k es) = bins bs  set (items es)"
proof -
  let ?bs = "upd_bins bs k es"
  have "bins (upd_bins bs k es) =  {set (items (?bs ! k)) |k. k < length ?bs}"
    unfolding bins_def by blast
  also have "... =  {set (items (bs ! l)) |l. l < length bs  l  k}  set (items (?bs ! k))"
    unfolding upd_bins_def using assms by (auto, metis nth_list_update)
  also have "... =  {set (items (bs ! l)) |l. l < length bs  l  k}  set (items (bs ! k))  set (items es)"
    using set_items_upds_bin[of es "bs!k"] by (simp add: assms upd_bins_def sup_assoc)
  also have "... =  {set (items (bs ! k)) |k. k < length bs}  set (items es)"
    using assms by blast
  also have "... = bins bs  set (items es)"
    unfolding bins_def by blast
  finally show ?thesis .
qed

lemma kth_bin_sub_bins:
  "k < length bs  set (items (bs ! k))  bins bs"
  unfolding bins_def bins_upto_def bin_upto_def by blast+

lemma bin_upto_Cons_0:
  "bin_upto (e#es) 0 = {}"
  by (auto simp: bin_upto_def)

lemma bin_upto_Cons:
  assumes "0 < n"
  shows "bin_upto (e#es) n = { fst e }  bin_upto es (n-1)"
proof -
  have "bin_upto (e#es) n = { items (e#es) ! j | j. j < n  j < length (items (e#es)) }"
    unfolding bin_upto_def by blast
  also have "... = { fst e }  { items es ! j | j. j < (n-1)  j < length (items es) }"
    using assms by (cases n) (auto simp: items_def nth_Cons', metis One_nat_def Zero_not_Suc diff_Suc_1 not_less_eq nth_map)
  also have "... = { fst e }  bin_upto es (n-1)"
    unfolding bin_upto_def by blast
  finally show ?thesis .
qed

lemma bin_upto_nth_idem_upd_bin:
  "n < length b  bin_upto (upd_bin e b) n = bin_upto b n"
proof (induction b arbitrary: e n)
  case (Cons b bs)
  show ?case
  proof (cases "x xp xs y yp ys. e = (x, PreRed xp xs)  b = (y, PreRed yp ys)")
    case True
    then obtain x xp xs y yp ys where "e = (x, PreRed xp xs)" "b = (y, PreRed yp ys)"
      by blast
    thus ?thesis
      using Cons bin_upto_Cons_0
      by (cases n) (auto simp: items_def bin_upto_Cons, blast+)
  next
    case False
    then show ?thesis
    proof cases
      assume *: "fst e = fst b"
      hence "upd_bin e (b # bs) = b # bs"
        using False by (auto split: pointer.splits prod.split)
      thus ?thesis
        using * by (auto simp: items_def)
    next
      assume *: "¬ fst e = fst b"
      hence "upd_bin e (b # bs) = b # upd_bin e bs"
        using False by (auto split: pointer.splits prod.split)
      thus ?thesis
        using * Cons
        by (cases n) (auto simp: items_def bin_upto_Cons_0 bin_upto_Cons)
    qed
  qed
qed (auto simp: items_def)

lemma bin_upto_nth_idem_upds_bin:
  "n < length b  bin_upto (upds_bin es b) n = bin_upto b n"
  using bin_upto_nth_idem_upd_bin length_upd_bin
  apply (induction es arbitrary: b)
   apply auto
  using order.strict_trans2 order.strict_trans1 by blast+

lemma bins_upto_kth_nth_idem:
  assumes "l < length bs" "k  l" "n < length (bs ! k)"
  shows "bins_upto (upd_bins bs l es) k n = bins_upto bs k n"
proof -
  let ?bs = "upd_bins bs l es"
  have "bins_upto ?bs k n =  {set (items (?bs ! l)) |l. l < k}  bin_upto (?bs ! k) n"
    unfolding bins_upto_def by blast
  also have "... =  {set (items (bs ! l)) |l. l < k}  bin_upto (?bs ! k) n"
    unfolding upd_bins_def using assms(1,2) by auto
  also have "... =  {set (items (bs ! l)) |l. l < k}  bin_upto (bs ! k) n"
    unfolding upd_bins_def using assms(1,3) bin_upto_nth_idem_upds_bin
    by (metis (no_types, lifting) nth_list_update)
  also have "... = bins_upto bs k n"
    unfolding bins_upto_def by blast
  finally show ?thesis .
qed

lemma bins_upto_sub_bins:
  "k < length bs  bins_upto bs k n  bins bs"
  unfolding bins_def bins_upto_def bin_upto_def using less_trans by (auto, blast)

lemma bins_upto_Suc_Un:
  "n < length (bs ! k)  bins_upto bs k (n+1) = bins_upto bs k n  { items (bs ! k) ! n }"
  unfolding bins_upto_def bin_upto_def using less_Suc_eq by (auto simp: items_def, metis nth_map)

lemma bins_bin_exists:
  "x  bins bs  k < length bs. x  set (items (bs ! k))"
  unfolding bins_def by blast

lemma distinct_upd_bin:
  "distinct (items b)  distinct (items (upd_bin e b))"
proof (induction b arbitrary: e)
  case (Cons b bs)
  show ?case
  proof (cases "x xp xs y yp ys. e = (x, PreRed xp xs)  b = (y, PreRed yp ys)")
    case True
    then obtain x xp xs y yp ys where "e = (x, PreRed xp xs)" "b = (y, PreRed yp ys)"
      by blast
    thus ?thesis
      using Cons
      apply (auto simp: items_def split: prod.split)
      by (metis Domain.DomainI Domain_fst UnE empty_iff fst_conv insert_iff items_def list.set_map set_items_upd_bin)
  next
    case False
    then show ?thesis
    proof cases
      assume *: "fst e = fst b"
      hence "upd_bin e (b # bs) = b # bs"
        using False by (auto split: pointer.splits prod.split)
      thus ?thesis
        using * Cons.prems by (auto simp: items_def)
    next
      assume *: "¬ fst e = fst b"
      hence "upd_bin e (b # bs) = b # upd_bin e bs"
        using False by (auto split: pointer.splits prod.split)
      moreover have "distinct (items (upd_bin e bs))"
        using Cons by (auto simp: items_def)
      ultimately show ?thesis
        using * Cons.prems set_items_upd_bin
        by (metis Un_insert_right distinct.simps(2) insertE items_def list.simps(9) sup_bot_right)
    qed
  qed
qed (auto simp: items_def)

lemma distinct_upds_bin:
  "distinct (items b)  distinct (items (upds_bin es b))"
  by (induction es arbitrary: b) (auto simp add: distinct_upd_bin)

lemma wf_bins_kth_bin:
  "wf_bins 𝒢 ω bs  k < length bs  x  set (items (bs ! k))  wf_item 𝒢 ω x  end_item x = k"
  using wf_bin_def wf_bins_def wf_bin_items_def by blast

lemma wf_bin_upd_bin:
  assumes "wf_bin 𝒢 ω k b" "wf_item 𝒢 ω (fst e)  end_item (fst e) = k"
  shows "wf_bin 𝒢 ω k (upd_bin e b)"
  using assms
proof (induction b arbitrary: e)
  case (Cons b bs)
  show ?case
  proof (cases "x xp xs y yp ys. e = (x, PreRed xp xs)  b = (y, PreRed yp ys)")
    case True
    then obtain x xp xs y yp ys where "e = (x, PreRed xp xs)" "b = (y, PreRed yp ys)"
      by blast
    thus ?thesis
      using Cons distinct_upd_bin wf_bin_def wf_bin_items_def set_items_upd_bin
      by (smt (verit, best) Un_insert_right insertE sup_bot.right_neutral)
  next
    case False
    then show ?thesis
    proof cases
      assume *: "fst e = fst b"
      hence "upd_bin e (b # bs) = b # bs"
        using False by (auto split: pointer.splits prod.split)
      thus ?thesis
        using * Cons.prems by (auto simp: items_def)
    next
      assume *: "¬ fst e = fst b"
      hence "upd_bin e (b # bs) = b # upd_bin e bs"
        using False by (auto split: pointer.splits prod.split)
      thus ?thesis
        using * Cons.prems set_items_upd_bin distinct_upd_bin wf_bin_def wf_bin_items_def
        by (smt (verit, best) Un_insert_right insertE sup_bot_right)
    qed
  qed
qed (auto simp: items_def wf_bin_def wf_bin_items_def)

lemma wf_upd_bins_bin:
  assumes "wf_bin 𝒢 ω k b"
  assumes "x  set (items es). wf_item 𝒢 ω x  end_item x = k"
  shows "wf_bin 𝒢 ω k (upds_bin es b)"
  using assms by (induction es arbitrary: b) (auto simp: wf_bin_upd_bin items_def)

lemma wf_bins_upd_bins:
  assumes "wf_bins 𝒢 ω bs"
  assumes "x  set (items es). wf_item 𝒢 ω x  end_item x = k"
  shows "wf_bins 𝒢 ω (upd_bins bs k es)"
  unfolding upd_bins_def using assms wf_upd_bins_bin wf_bins_def
  by (metis length_list_update nth_list_update_eq nth_list_update_neq)

lemma wf_bins_impl_wf_items:
  "wf_bins 𝒢 ω bs  x  (bins bs). wf_item 𝒢 ω x"
  unfolding wf_bins_def wf_bin_def wf_bin_items_def bins_def by auto

lemma upds_bin_eq_items:
  "set (items es)  set (items b)  set (items (upds_bin es b)) = set (items b)"
  apply (induction es arbitrary: b)
   apply (auto simp: set_items_upd_bin set_items_upds_bin)
   apply (simp add: items_def)
  by (metis Un_upper2 upds_bin.simps(2) in_mono set_items_upds_bin sup.orderE)

lemma bin_eq_items_upd_bin:
  "fst e  set (items b)  items (upd_bin e b) = items b"
proof (induction b arbitrary: e)
  case (Cons b bs)
  show ?case
  proof (cases "x xp xs y yp ys. e = (x, PreRed xp xs)  b = (y, PreRed yp ys)")
    case True
    then obtain x xp xs y yp ys where "e = (x, PreRed xp xs)" "b = (y, PreRed yp ys)"
      by blast
    thus ?thesis
      using Cons by (auto simp: items_def, metis fst_conv image_eqI)
  next
    case False
    then show ?thesis
    proof cases
      assume *: "fst e = fst b"
      hence "upd_bin e (b # bs) = b # bs"
        using False by (auto split: pointer.splits prod.split)
      thus ?thesis
        using * Cons.prems by (auto simp: items_def)
    next
      assume *: "¬ fst e = fst b"
      hence "upd_bin e (b # bs) = b # upd_bin e bs"
        using False by (auto split: pointer.splits prod.split)
      thus ?thesis
        using * Cons by (auto simp: items_def)
    qed
  qed
qed (auto simp: items_def)

lemma bin_eq_items_upds_bin:
  assumes "set (items es)  set (items b)"
  shows "items (upds_bin es b) = items b"
  using assms
proof (induction es arbitrary: b)
  case (Cons e es)
  have "items (upds_bin es (upd_bin e b)) = items (upd_bin e b)"
    using Cons upds_bin_eq_items set_items_upd_bin set_items_upds_bin
    by (metis Un_upper2 upds_bin.simps(2) sup.coboundedI1)
  moreover have "items (upd_bin e b) = items b"
    by (metis Cons.prems bin_eq_items_upd_bin items_def list.set_intros(1) list.simps(9) subset_code(1))
  ultimately show ?case
    by simp
qed (auto simp: items_def)

lemma bins_eq_items_upd_bins:
  assumes "set (items es)  set (items (bs!k))"
  shows "bins_eq_items (upd_bins bs k es) bs"
  unfolding upd_bins_def using assms bin_eq_items_upds_bin bins_eq_items_def
  by (metis list_update_id map_update)

lemma bins_eq_items_imp_eq_bins:
  "bins_eq_items bs bs'  bins bs = bins bs'"
  unfolding bins_eq_items_def bins_def items_def
  by (metis (no_types, lifting) length_map nth_map)

lemma bin_eq_items_dist_upd_bin_bin:
  assumes "items a = items b"
  shows "items (upd_bin e a) = items (upd_bin e b)"
  using assms
proof (induction a arbitrary: e b)
  case (Cons a as)
  obtain b' bs where bs: "b = b' # bs" "fst a = fst b'" "items as = items bs"
    using Cons.prems by (auto simp: items_def)
  show ?case
  proof (cases "x xp xs y yp ys. e = (x, PreRed xp xs)  a = (y, PreRed yp ys)")
    case True
    then obtain x xp xs y yp ys where #: "e = (x, PreRed xp xs)" "a = (y, PreRed yp ys)"
      by blast
    show ?thesis
    proof cases
      assume *: "x = y"
      hence "items (upd_bin e (a # as)) = x # items as"
        using # by (auto simp: items_def)
      moreover have "items (upd_bin e (b' # bs)) = x # items bs"
        using bs # * by (auto simp: items_def split: pointer.splits prod.splits)
      ultimately show ?thesis
        using bs by simp
    next
      assume *: "¬ x = y"
      hence "items (upd_bin e (a # as)) = y # items (upd_bin e as)"
        using # by (auto simp: items_def)
      moreover have "items (upd_bin e (b' # bs)) = y # items (upd_bin e bs)"
        using bs # * by (auto simp: items_def split: pointer.splits prod.splits)
      ultimately show ?thesis
        using bs Cons.IH by simp
    qed
  next
    case False
    then show ?thesis
    proof cases
      assume *: "fst e = fst a"
      hence "items (upd_bin e (a # as)) = fst a # items as"
        using False by (auto simp: items_def split: pointer.splits prod.splits)
      moreover have "items (upd_bin e (b' # bs)) = fst b' # items bs"
        using bs False * by (auto simp: items_def split: pointer.splits prod.splits)
      ultimately show ?thesis
        using bs by simp
    next
      assume *: "¬ fst e = fst a"
      hence "items (upd_bin e (a # as)) = fst a # items (upd_bin e as)"
        using False by (auto simp: items_def split: pointer.splits prod.splits)
      moreover have "items (upd_bin e (b' # bs)) = fst b' # items (upd_bin e bs)"
        using bs False * by (auto simp: items_def split: pointer.splits prod.splits)
      ultimately show ?thesis
        using bs Cons by simp
    qed
  qed
qed (auto simp: items_def)

lemma bin_eq_items_dist_upds_bin_bin:
  assumes "items a = items b"
  shows "items (upds_bin es a) = items (upds_bin es b)"
  using assms
proof (induction es arbitrary: a b)
  case (Cons e es)
  hence "items (upds_bin es (upd_bin e a)) = items (upds_bin es (upd_bin e b))"
    using bin_eq_items_dist_upd_bin_bin by blast
  thus ?case
    by simp
qed simp

lemma bin_eq_items_dist_upd_bin_entry:
  assumes "fst e = fst e'"
  shows "items (upd_bin e b) = items (upd_bin e' b)"
  using assms
proof (induction b arbitrary: e e')
  case (Cons a as)
  show ?case
  proof (cases "x xp xs y yp ys. e = (x, PreRed xp xs)  a = (y, PreRed yp ys)")
    case True
    then obtain x xp xs y yp ys where #: "e = (x, PreRed xp xs)" "a = (y, PreRed yp ys)"
      by blast
    show ?thesis
    proof cases
      assume *: "x = y"
      thus ?thesis
        using # Cons.prems by (auto simp: items_def split: pointer.splits prod.splits)
    next
      assume *: "¬ x = y"
      thus ?thesis
        using # Cons.prems
        by (auto simp: items_def split!: pointer.splits prod.splits, metis Cons.IH Cons.prems items_def)+
    qed
  next
    case False
    then show ?thesis
    proof cases
      assume *: "fst e = fst a"
      thus ?thesis
        using Cons.prems by (auto simp: items_def split: pointer.splits prod.splits)
    next
      assume *: "¬ fst e = fst a"
      thus ?thesis
        using Cons.prems
        by (auto simp: items_def split!: pointer.splits prod.splits, metis Cons.IH Cons.prems items_def)+
    qed
  qed
qed (auto simp: items_def)

lemma bin_eq_items_dist_upds_bin_entries:
  assumes "items es = items es'"
  shows "items (upds_bin es b) = items (upds_bin es' b)"
  using assms
proof (induction es arbitrary: es' b)
  case (Cons e es)
  then obtain e' es'' where "fst e = fst e'" "items es = items es''" "es' = e' # es''"
    by (auto simp: items_def)
  hence "items (upds_bin es (upd_bin e b)) = items (upds_bin es'' (upd_bin e' b))"
    using Cons.IH
    by (metis bin_eq_items_dist_upd_bin_entry bin_eq_items_dist_upds_bin_bin)
  thus ?case
    by (simp add: es' = e' # es'')
qed (auto simp: items_def)

lemma bins_eq_items_dist_upd_bins:
  assumes "bins_eq_items as bs" "items aes = items bes" "k < length as"
  shows "bins_eq_items (upd_bins as k aes) (upd_bins bs k bes)"
proof -
  have "k < length bs"
    using assms(1,3) bins_eq_items_def map_eq_imp_length_eq by metis
  hence "items (upds_bin (as!k) aes) = items (upds_bin (bs!k) bes)"
    using bin_eq_items_dist_upds_bin_entries bin_eq_items_dist_upds_bin_bin bins_eq_items_def assms
    by (metis (no_types, lifting) nth_map)
  thus ?thesis
    using k < length bs assms bin_eq_items_dist_upds_bin_bin bin_eq_items_dist_upds_bin_entries
      bins_eq_items_def upd_bins_def by (smt (verit) map_update nth_map)
qed


subsection ‹Well-formed bins›

lemma wf_bins_ScanL':
  assumes "wf_bins 𝒢 ω bs" "k < length bs" "x  set (items (bs ! k))"
  assumes "k < length ω" "next_symbol x  None" "y = inc_item x (k+1)"
  shows "wf_item 𝒢 ω y  end_item y = k+1"
  using assms wf_bins_kth_bin[OF assms(1-3)]
  unfolding wf_item_def inc_item_def next_symbol_def is_complete_def rhs_item_def
  by (auto split: if_splits)

lemma wf_bins_ScanL:
  assumes "wf_bins 𝒢 ω bs" "k < length bs" "x  set (items (bs ! k))" "k < length ω" "next_symbol x  None"
  shows "y  set (items (ScanL k ω a x pre)). wf_item 𝒢 ω y  end_item y = (k+1)"
  using wf_bins_ScanL'[OF assms] by (simp add: ScanL_def items_def)

lemma wf_bins_PredictL:
  assumes "wf_bins 𝒢 ω bs" "k < length bs" "k  length ω"
  shows "y  set (items (PredictL k 𝒢 X)). wf_item 𝒢 ω y  end_item y = k"
  using assms by (auto simp: PredictL_def wf_item_def wf_bins_def wf_bin_def init_item_def items_def)

lemma wf_item_inc_item:
  assumes "wf_item 𝒢 ω x" "next_symbol x = Some a" "start_item x  k" "k  length ω"
  shows "wf_item 𝒢 ω (inc_item x k)  end_item (inc_item x k) = k"
  using assms by (auto simp: wf_item_def inc_item_def rhs_item_def next_symbol_def is_complete_def split: if_splits)

lemma wf_bins_CompleteL:
  assumes "wf_bins 𝒢 ω bs" "k < length bs" "y  set (items (bs ! k))"
  shows "x  set (items (CompleteL k y bs red)). wf_item 𝒢 ω x  end_item x = k"
proof -
  let ?orig = "bs ! (start_item y)"
  let ?is = "filter_with_index (λx. next_symbol x = Some (lhs_item y)) (items ?orig)"
  let ?is' = "map (λ(x, pre). (inc_item x k, PreRed (start_item y, pre, red) [])) ?is"
  {
    fix x
    assume *: "x  set (map fst ?is)"
    have "end_item x = start_item y"
      using * assms wf_bins_kth_bin wf_item_def filter_with_index_cong_filter
      by (metis dual_order.strict_trans2 filter_is_subset subsetD)
    have "wf_item 𝒢 ω x"
      using * assms wf_bins_kth_bin wf_item_def filter_with_index_cong_filter
      by (metis dual_order.strict_trans2 filter_is_subset subsetD)
    moreover have "next_symbol x = Some (lhs_item y)"
      using * filter_set filter_with_index_cong_filter member_filter by metis
    moreover have "start_item x  k"
      using end_item x = start_item y wf_item 𝒢 ω x assms wf_bins_kth_bin wf_item_def
      by (metis dual_order.order_iff_strict dual_order.strict_trans1)
    moreover have "k  length ω"
      using assms wf_bins_kth_bin wf_item_def by blast
    ultimately have "wf_item 𝒢 ω (inc_item x k)" "end_item (inc_item x k) = k"
      by (simp_all add: wf_item_inc_item)
  }
  hence "x  set (items ?is'). wf_item 𝒢 ω x  end_item x = k"
    by (auto simp: items_def rev_image_eqI)
  thus ?thesis
    unfolding CompleteL_def by presburger
qed

lemma Ex_wf_bins:
  "n bs ω 𝒢. n  length ω  length bs = Suc (length ω)  wf_bins 𝒢 ω bs"
  apply (rule exI[where x="0"])
  apply (rule exI[where x="[[]]"])
  apply (rule exI[where x="[]"])
  by (auto simp: wf_bins_def wf_bin_def wf_bin_items_def items_def split: prod.splits)

definition wf_earley_input :: "(nat × 'a cfg × 'a list × 'a bins) set" where
  "wf_earley_input = {
    (k, 𝒢, ω, bs) | k 𝒢 ω bs.
      k  length ω 
      length bs = length ω + 1 
      wf_bins 𝒢 ω bs
  }"

typedef 'a wf_bins = "wf_earley_input::(nat × 'a cfg × 'a list × 'a bins) set"
  morphisms from_wf_bins to_wf_bins
  using Ex_wf_bins by (auto simp: wf_earley_input_def)

lemma wf_earley_input_elim:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  shows "k  length ω  k < length bs  length bs = length ω + 1  wf_bins 𝒢 ω bs"
  using assms(1) from_wf_bins wf_earley_input_def by (smt (verit) Suc_eq_plus1 less_Suc_eq_le mem_Collect_eq prod.sel(1) snd_conv)

lemma wf_earley_input_intro:
  assumes "k  length ω" "length bs = length ω + 1" "wf_bins 𝒢 ω bs"
  shows "(k, 𝒢, ω, bs)  wf_earley_input"
  by (simp add: assms wf_earley_input_def)

lemma wf_earley_input_CompleteL:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input" "¬ length (items (bs ! k))  i"
  assumes "x = items (bs ! k) ! i" "next_symbol x = None"
  shows "(k, 𝒢, ω, upd_bins bs k (CompleteL k x bs red))  wf_earley_input"
proof -
  have *: "k  length ω" "length bs = length ω + 1" "wf_bins 𝒢 ω bs"
    using wf_earley_input_elim assms(1) by metis+
  have x: "x  set (items (bs ! k))"
    using assms(2,3) by simp
  have "start_item x < length bs"
    using x wf_bins_kth_bin * wf_item_def
    by (metis One_nat_def add.right_neutral add_Suc_right dual_order.trans le_imp_less_Suc)
  hence "wf_bins 𝒢 ω (upd_bins bs k (CompleteL k x bs red))"
    using * Suc_eq_plus1 le_imp_less_Suc wf_bins_CompleteL wf_bins_upd_bins x by metis
  thus ?thesis
    by (simp add: *(1-3) wf_earley_input_def)
qed

lemma wf_earley_input_ScanL:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input" "¬ length (items (bs ! k))  i"
  assumes "x = items (bs ! k) ! i" "next_symbol x = Some a"
  assumes "k < length ω"
  shows "(k, 𝒢, ω, upd_bins bs (k+1) (ScanL k ω a x pre))  wf_earley_input"
proof -
  have *: "k  length ω" "length bs = length ω + 1" "wf_bins 𝒢 ω bs"
    using wf_earley_input_elim assms(1) by metis+
  have x: "x  set (items(bs ! k))"
    using assms(2,3) by simp
  have "wf_bins 𝒢 ω (upd_bins bs (k+1) (ScanL k ω a x pre))"
    using * x assms(1,4,5) wf_bins_ScanL wf_bins_upd_bins wf_earley_input_elim
    by (metis option.discI)
  thus ?thesis
    by (simp add: *(1-3) wf_earley_input_def)
qed

lemma wf_earley_input_PredictL:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input" "¬ length (items (bs ! k))  i"
  assumes "x = items (bs ! k) ! i" "next_symbol x = Some a"
  shows "(k, 𝒢, ω, upd_bins bs k (PredictL k 𝒢 a))  wf_earley_input"
proof -
  have *: "k  length ω" "length bs = length ω + 1" "wf_bins 𝒢 ω bs"
    using wf_earley_input_elim assms(1) by metis+
  have x: "x  set (items (bs ! k))"
    using assms(2,3) by simp
  hence "wf_bins 𝒢 ω (upd_bins bs k (PredictL k 𝒢 a))"
    using * x assms(1,4) wf_bins_PredictL wf_bins_upd_bins wf_earley_input_elim by metis
  thus ?thesis
    by (simp add: *(1-3) wf_earley_input_def)
qed

fun earley_measure :: "nat × 'a cfg × 'a list × 'a bins  nat  nat" where
  "earley_measure (k, 𝒢, ω, bs) i = card { x | x. wf_item 𝒢 ω x  end_item x = k } - i"

lemma EarleyL_bin'_simps[simp]:
  "i  length (items (bs ! k))  EarleyL_bin' k 𝒢 ω bs i = bs"
  "¬ i  length (items (bs ! k))  x = items (bs!k) ! i  next_symbol x = None 
    EarleyL_bin' k 𝒢 ω bs i = EarleyL_bin' k 𝒢 ω (upd_bins bs k (CompleteL k x bs i)) (i+1)"
  "¬ i  length (items (bs ! k))  x = items (bs!k) ! i  next_symbol x = Some a 
    a  nonterminals 𝒢  k < length ω  EarleyL_bin' k 𝒢 ω bs i = EarleyL_bin' k 𝒢 ω (upd_bins bs (k+1) (ScanL k ω a x i)) (i+1)"
  "¬ i  length (items (bs ! k))  x = items (bs!k) ! i  next_symbol x = Some a 
    a  nonterminals 𝒢  ¬ k < length ω  EarleyL_bin' k 𝒢 ω bs i = EarleyL_bin' k 𝒢 ω bs (i+1)"
  "¬ i  length (items (bs ! k))  x = items (bs!k) ! i  next_symbol x = Some a 
    a  nonterminals 𝒢  EarleyL_bin' k 𝒢 ω bs i = EarleyL_bin' k 𝒢 ω (upd_bins bs k (PredictL k 𝒢 a)) (i+1)"
  by (subst EarleyL_bin'.simps, auto)+

lemma EarleyL_bin'_induct[case_names Base CompleteF ScanF Pass PredictF]:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  assumes base: "k 𝒢 ω bs i. i  length (items (bs ! k))  P k 𝒢 ω bs i"
  assumes complete: "k 𝒢 ω bs i x. ¬ i  length (items (bs ! k))  x = items (bs ! k) ! i 
            next_symbol x = None  P k 𝒢 ω (upd_bins bs k (CompleteL k x bs i)) (i+1)  P k 𝒢 ω bs i"
  assumes scan: "k 𝒢 ω bs i x a. ¬ i  length (items (bs ! k))  x = items (bs ! k) ! i 
            next_symbol x = Some a  a  nonterminals 𝒢  k < length ω 
            P k 𝒢 ω (upd_bins bs (k+1) (ScanL k ω a x i)) (i+1)  P k 𝒢 ω bs i"
  assumes pass: "k 𝒢 ω bs i x a. ¬ i  length (items (bs ! k))  x = items (bs ! k) ! i 
            next_symbol x = Some a  a  nonterminals 𝒢  ¬ k < length ω 
            P k 𝒢 ω bs (i+1)  P k 𝒢 ω bs i"
  assumes predict: "k 𝒢 ω bs i x a. ¬ i  length (items (bs ! k))  x = items (bs ! k) ! i 
            next_symbol x = Some a  a  nonterminals 𝒢 
            P k 𝒢 ω (upd_bins bs k (PredictL k 𝒢 a)) (i+1)  P k 𝒢 ω bs i"
  shows "P k 𝒢 ω bs i"
  using assms(1)
proof (induction n"earley_measure (k, 𝒢, ω, bs) i" arbitrary: bs i rule: nat_less_induct)
  case 1
  have wf: "k  length ω" "length bs = length ω + 1" "wf_bins 𝒢 ω bs"
    using "1.prems" wf_earley_input_elim by metis+
  hence k: "k < length bs"
    by simp
  have fin: "finite { x | x. wf_item 𝒢 ω x  end_item x = k }"
    using finiteness_UNIV_wf_item by fastforce
  show ?case
  proof cases
    assume "i  length (items (bs ! k))"
    then show ?thesis
      by (simp add: base)
  next
    assume a1: "¬ i  length (items (bs ! k))"
    let ?x = "items (bs ! k) ! i"
    have x: "?x  set (items (bs ! k))"
      using a1 by fastforce
    show ?thesis
    proof cases
      assume a2: "next_symbol ?x = None"
      let ?bs' = "upd_bins bs k (CompleteL k ?x bs i)"
      have "start_item ?x < length bs"
        using wf(3) k wf_bins_kth_bin wf_item_def x by (metis order_le_less_trans)
      hence wf_bins': "wf_bins 𝒢 ω ?bs'"
        using wf_bins_CompleteL wf(3) wf_bins_upd_bins k x by metis
      hence wf': "(k, 𝒢, ω, ?bs')  wf_earley_input"
        using wf(1,2,3) wf_earley_input_intro by fastforce
      have sub: "set (items (?bs' ! k))  { x | x. wf_item 𝒢 ω x  end_item x = k }"
        using wf(1,2) wf_bins' unfolding wf_bin_def wf_bins_def wf_bin_items_def using order_le_less_trans by auto
      have "i < length (items (?bs' ! k))"
        using a1 by (metis dual_order.strict_trans1 items_def leI length_map length_nth_upd_bin_bins)
      also have "... = card (set (items (?bs' ! k)))"
        using wf(1,2) wf_bins' distinct_card wf_bins_def wf_bin_def by (metis k length_upd_bins)
      also have "...  card {x |x. wf_item 𝒢 ω x  end_item x = k}"
        using card_mono fin sub by blast
      finally have "card {x |x. wf_item 𝒢 ω x  end_item x = k} > i"
        by blast
      hence "earley_measure (k, 𝒢, ω, ?bs') (Suc i) < earley_measure (k, 𝒢, ω, bs) i"
        by simp
      thus ?thesis
        using 1 a1 a2 complete wf' by simp
    next
      assume a2: "¬ next_symbol ?x = None"
      then obtain a where a_def: "next_symbol ?x = Some a"
        by blast
      show ?thesis
      proof cases
        assume a3: "a  nonterminals 𝒢"
        show ?thesis
        proof cases
          assume a4: "k < length ω"
          let ?bs' = "upd_bins bs (k+1) (ScanL k ω a ?x i)"
          have wf_bins': "wf_bins 𝒢 ω ?bs'"
            using wf_bins_ScanL wf(1,3) wf_bins_upd_bins a2 a4 k x by metis
          hence wf': "(k, 𝒢, ω, ?bs')  wf_earley_input"
            using wf(1,2,3) wf_earley_input_intro by fastforce
          have sub: "set (items (?bs' ! k))  { x | x. wf_item 𝒢 ω x  end_item x = k }"
            using wf(1,2) wf_bins' unfolding wf_bin_def wf_bins_def wf_bin_items_def using order_le_less_trans by auto
          have "i < length (items (?bs' ! k))"
            using a1 by (metis dual_order.strict_trans1 items_def leI length_map length_nth_upd_bin_bins)
          also have "... = card (set (items (?bs' ! k)))"
            using wf(1,2) wf_bins' distinct_card wf_bins_def wf_bin_def
            by (metis Suc_eq_plus1 le_imp_less_Suc length_upd_bins)
          also have "...  card {x |x. wf_item 𝒢 ω x  end_item x = k}"
            using card_mono fin sub by blast
          finally have "card {x |x. wf_item 𝒢 ω x  end_item x = k} > i"
            by blast
          hence "earley_measure (k, 𝒢, ω, ?bs') (Suc i) < earley_measure (k, 𝒢, ω, bs) i"
            by simp
          thus ?thesis
            using 1 a1 a_def a3 a4 scan wf' by simp
        next
          assume a4: "¬ k < length ω"
          have sub: "set (items (bs ! k))  { x | x. wf_item 𝒢 ω x  end_item x = k }"
            using wf unfolding wf_bin_def wf_bins_def wf_bin_items_def using order_le_less_trans by auto
          have "i < length (items (bs ! k))"
            using a1 by simp
          also have "... = card (set (items (bs ! k)))"
            using wf distinct_card wf_bins_def wf_bin_def by (metis Suc_eq_plus1 le_imp_less_Suc)
          also have "...  card {x |x. wf_item 𝒢 ω x  end_item x = k}"
            using card_mono fin sub by blast
          finally have "card {x |x. wf_item 𝒢 ω x  end_item x = k} > i"
            by blast
          hence "earley_measure (k, 𝒢, ω, bs) (Suc i) < earley_measure (k, 𝒢, ω, bs) i"
            by simp
          thus ?thesis
            using 1 a1 a3 a4 a_def pass by simp
        qed
      next
        assume a3: "¬ a  nonterminals 𝒢"
        let ?bs' = "upd_bins bs k (PredictL k 𝒢 a)"
        have wf_bins': "wf_bins 𝒢 ω ?bs'"
          using wf_bins_PredictL wf wf_bins_upd_bins k x by metis
        hence wf': "(k, 𝒢, ω, ?bs')  wf_earley_input"
          using wf(1,2,3) wf_earley_input_intro by fastforce
        have sub: "set (items (?bs' ! k))  { x | x. wf_item 𝒢 ω x  end_item x = k }"
          using wf(1,2) wf_bins' unfolding wf_bin_def wf_bins_def wf_bin_items_def using order_le_less_trans by auto
        have "i < length (items (?bs' ! k))"
          using a1 by (metis dual_order.strict_trans1 items_def leI length_map length_nth_upd_bin_bins)
        also have "... = card (set (items (?bs' ! k)))"
          using wf(1,2) wf_bins' distinct_card wf_bins_def wf_bin_def
          by (metis Suc_eq_plus1 le_imp_less_Suc length_upd_bins)
        also have "...  card {x |x. wf_item 𝒢 ω x  end_item x = k}"
          using card_mono fin sub by blast
        finally have "card {x |x. wf_item 𝒢 ω x  end_item x = k} > i"
          by blast
        hence "earley_measure (k, 𝒢, ω, ?bs') (Suc i) < earley_measure (k, 𝒢, ω, bs) i"
          by simp
        thus ?thesis
          using 1 a1 a_def a3 a_def predict wf' by simp
      qed
    qed
  qed
qed

lemma wf_earley_input_EarleyL_bin':
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  shows "(k, 𝒢, ω, EarleyL_bin' k 𝒢 ω bs i)  wf_earley_input"
  using assms
proof (induction i rule: EarleyL_bin'_induct[OF assms(1), case_names Base CompleteF ScanF Pass PredictF])
  case (CompleteF k 𝒢 ω bs i x)
  let ?bs' = "upd_bins bs k (CompleteL k x bs i)"
  have "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using CompleteF.hyps CompleteF.prems wf_earley_input_CompleteL by blast
  thus ?case
    using CompleteF.IH CompleteF.hyps by simp
next
  case (ScanF k 𝒢 ω bs i x a)
  let ?bs' = "upd_bins bs (k+1) (ScanL k ω a x i)"
  have "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using ScanF.hyps ScanF.prems wf_earley_input_ScanL by metis
  thus ?case
    using ScanF.IH ScanF.hyps by simp
next
  case (PredictF k 𝒢 ω bs i x a)
  let ?bs' = "upd_bins bs k (PredictL k 𝒢 a)"
  have "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using PredictF.hyps PredictF.prems wf_earley_input_PredictL by metis
  thus ?case
    using PredictF.IH PredictF.hyps by simp
qed simp_all

lemma wf_earley_input_EarleyL_bin:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  shows "(k, 𝒢, ω, EarleyL_bin k 𝒢 ω bs)  wf_earley_input"
  using assms by (simp add: EarleyL_bin_def wf_earley_input_EarleyL_bin')

lemma length_bins_EarleyL_bin':
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  shows "length (EarleyL_bin' k 𝒢 ω bs i) = length bs"
  by (metis assms wf_earley_input_EarleyL_bin' wf_earley_input_elim)

lemma length_nth_bin_EarleyL_bin':
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  shows "length (items (EarleyL_bin' k 𝒢 ω bs i ! l))  length (items (bs ! l))"
  using length_nth_upd_bin_bins order_trans
  by (induction i rule: EarleyL_bin'_induct[OF assms]) (auto simp: items_def, blast+)

lemma wf_bins_EarleyL_bin':
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  shows "wf_bins 𝒢 ω (EarleyL_bin' k 𝒢 ω bs i)"
  using assms wf_earley_input_EarleyL_bin' wf_earley_input_elim by blast

lemma wf_bins_EarleyL_bin:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  shows "wf_bins 𝒢 ω (EarleyL_bin k 𝒢 ω bs)"
  using assms EarleyL_bin_def wf_bins_EarleyL_bin' by metis

lemma kth_EarleyL_bin'_bins:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  assumes "j < length (items (bs ! l))"
  shows "items (EarleyL_bin' k 𝒢 ω bs i ! l) ! j = items (bs ! l) ! j"
  using assms(2)
proof (induction i rule: EarleyL_bin'_induct[OF assms(1), case_names Base CompleteF ScanF Pass PredictF])
  case (CompleteF k 𝒢 ω bs i x)
  let ?bs' = "upd_bins bs k (CompleteL k x bs i)"
  have "items (EarleyL_bin' k 𝒢 ω ?bs' (i + 1) ! l) ! j = items (?bs' ! l) ! j"
    using CompleteF.IH CompleteF.prems length_nth_upd_bin_bins items_def order.strict_trans2 by (metis length_map)
  also have "... = items (bs ! l) ! j"
    using CompleteF.prems items_nth_idem_upd_bins nth_idem_upd_bins length_map items_def by metis
  finally show ?case
    using CompleteF.hyps by simp
next
  case (ScanF k 𝒢 ω bs i x a)
  let ?bs' = "upd_bins bs (k+1) (ScanL k ω a x i)"
  have "items (EarleyL_bin' k 𝒢 ω ?bs' (i + 1) ! l) ! j = items (?bs' ! l) ! j"
    using ScanF.IH ScanF.prems length_nth_upd_bin_bins order.strict_trans2 items_def by (metis length_map)
  also have "... = items (bs ! l) ! j"
    using ScanF.prems items_nth_idem_upd_bins nth_idem_upd_bins length_map items_def by metis
  finally show ?case
    using ScanF.hyps by simp
next
  case (PredictF k 𝒢 ω bs i x a)
  let ?bs' = "upd_bins bs k (PredictL k 𝒢 a)"
  have "items (EarleyL_bin' k 𝒢 ω ?bs' (i + 1) ! l) ! j = items (?bs' ! l) ! j"
    using PredictF.IH PredictF.prems length_nth_upd_bin_bins order.strict_trans2 items_def by (metis length_map)
  also have "... = items (bs ! l) ! j"
    using PredictF.prems items_nth_idem_upd_bins nth_idem_upd_bins length_map items_def by metis
  finally show ?case
    using PredictF.hyps by simp
qed simp_all

lemma nth_bin_sub_EarleyL_bin':
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  shows "set (items (bs ! l))  set (items (EarleyL_bin' k 𝒢 ω bs i ! l))"
proof standard
  fix x
  assume "x  set (items (bs ! l))"
  then obtain j where *: "j < length (items (bs ! l))" "items (bs ! l) ! j = x"
    using in_set_conv_nth by metis
  have "x = items (EarleyL_bin' k 𝒢 ω bs i ! l) ! j"
    using kth_EarleyL_bin'_bins assms * by metis
  moreover have "j < length (items (EarleyL_bin' k 𝒢 ω bs i ! l))"
    using assms *(1) length_nth_bin_EarleyL_bin' less_le_trans by blast
  ultimately show "x  set (items (EarleyL_bin' k 𝒢 ω bs i ! l))"
    by simp
qed

lemma nth_EarleyL_bin'_eq:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  shows "l < k  EarleyL_bin' k 𝒢 ω bs i ! l = bs ! l"
  by (induction i rule: EarleyL_bin'_induct[OF assms]) (auto simp: upd_bins_def)

lemma set_items_EarleyL_bin'_eq:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  shows "l < k  set (items (EarleyL_bin' k 𝒢 ω bs i ! l)) = set (items (bs ! l))"
  by (simp add: assms nth_EarleyL_bin'_eq)

lemma bins_upto_k0_EarleyL_bin'_eq:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  shows "bins_upto (EarleyL_bin k 𝒢 ω bs) k 0 = bins_upto bs k 0"
  unfolding bins_upto_def bin_upto_def EarleyL_bin_def using set_items_EarleyL_bin'_eq assms nth_EarleyL_bin'_eq by fastforce

lemma wf_earley_input_InitL:
  assumes "k  length ω"
  shows "(k, 𝒢, ω, InitL 𝒢 ω)  wf_earley_input"
proof -
  let ?rs = "filter (λr. lhs_rule r = 𝔖 𝒢) (remdups ( 𝒢))"
  let ?b0 = "map (λr. (init_item r 0, Null)) ?rs"
  let ?bs = "replicate (length ω + 1) ([])"
  have "distinct (items ?b0)"
    using assms unfolding wf_bin_def wf_item_def items_def
    by (auto simp: init_item_def distinct_map inj_on_def)
  moreover have "x  set (items ?b0). wf_item 𝒢 ω x  end_item x = 0"
    using assms unfolding wf_bin_def wf_item_def by (auto simp: init_item_def items_def)
  moreover have "wf_bins 𝒢 ω ?bs"
    unfolding wf_bins_def wf_bin_def wf_bin_items_def items_def using less_Suc_eq_0_disj by force
  ultimately show ?thesis
    using assms length_replicate wf_earley_input_intro
    unfolding wf_bin_def InitL_def wf_bin_def wf_bin_items_def wf_bins_def
    by (metis (no_types, lifting) length_list_update nth_list_update_eq nth_list_update_neq)
qed

lemma length_bins_InitL[simp]:
  "length (InitL 𝒢 ω) = length ω + 1"
  by (simp add: InitL_def)

lemma wf_earley_input_EarleyL_bins[simp]:
  assumes "k  length ω"
  shows "(k, 𝒢, ω, EarleyL_bins k 𝒢 ω)  wf_earley_input"
  using assms
proof (induction k)
  case 0
  have "(k, 𝒢, ω, InitL 𝒢 ω)  wf_earley_input"
    using assms wf_earley_input_InitL by blast
  thus ?case
    by (simp add: assms wf_earley_input_InitL wf_earley_input_EarleyL_bin)
next
  case (Suc k)
  have "(Suc k, 𝒢, ω, EarleyL_bins k 𝒢 ω)  wf_earley_input"
    using Suc.IH Suc.prems(1) Suc_leD assms wf_earley_input_elim wf_earley_input_intro by metis
  thus ?case
    by (simp add: wf_earley_input_EarleyL_bin)
qed

lemma length_EarleyL_bins[simp]:
  assumes "k  length ω"
  shows "length (EarleyL_bins k 𝒢 ω) = length (InitL 𝒢 ω)"
  using assms wf_earley_input_EarleyL_bins wf_earley_input_elim by fastforce

lemma wf_bins_EarleyL_bins[simp]:
  assumes "k  length ω"
  shows "wf_bins 𝒢 ω (EarleyL_bins k 𝒢 ω)"
  using assms wf_earley_input_EarleyL_bins wf_earley_input_elim by fastforce

lemma wf_bins_EarleyL:
  "wf_bins 𝒢 ω (EarleyL 𝒢 ω)"
  by (simp add: EarleyL_def)


subsection ‹Soundness›

lemma InitL_eq_InitF:
  "bins (InitL 𝒢 ω) = InitF 𝒢"
proof -
  let ?rs = "filter (λr. lhs_rule r = 𝔖 𝒢) (remdups ( 𝒢))"
  let ?b0 = "map (λr. (init_item r 0, Null)) ?rs"
  let ?bs = "replicate (length ω + 1) ([])"
  have "bins (?bs[0 := ?b0]) = set (items ?b0)"
  proof -
    have "bins (?bs[0 := ?b0]) =  {set (items ((?bs[0 := ?b0]) ! k)) |k. k < length (?bs[0 := ?b0])}"
      unfolding bins_def by blast
    also have "... = set (items ((?bs[0 := ?b0]) ! 0))   {set (items ((?bs[0 := ?b0]) ! k)) |k. k < length (?bs[0 := ?b0])  k  0}"
      by fastforce
    also have "... = set (items (?b0))"
      by (auto simp: items_def)
    finally show ?thesis .
  qed
  also have "... = InitF 𝒢"
    by (auto simp: InitF_def items_def lhs_rule_def)
  finally show ?thesis
    by (auto simp: InitL_def)
qed

lemma ScanL_sub_ScanF:
  assumes "wf_bins 𝒢 ω bs" "bins bs  I" "x  set (items (bs ! k))" "k < length bs" "k < length ω"
  assumes "next_symbol x = Some a"
  shows "set (items (ScanL k ω a x pre))  ScanF k ω I"
proof standard
  fix y
  assume *: "y  set (items (ScanL k ω a x pre))"
  have "x  bin I k"
    using kth_bin_sub_bins assms(1-4) items_def wf_bin_def wf_bins_def wf_bin_items_def bin_def by fastforce
  {
    assume #: "k < length ω" "ω!k = a"
    hence "y = inc_item x (k+1)"
      using * unfolding ScanL_def by (simp add: items_def)
    hence "y  ScanF k ω I"
      using x  bin I k # assms(6) unfolding ScanF_def by blast
  }
  thus "y  ScanF k ω I"
    using * assms(5) unfolding ScanL_def by (auto simp: items_def)
qed

lemma PredictL_sub_PredictF:
  assumes "wf_bins 𝒢 ω bs" "bins bs  I" "x  set (items (bs ! k))" "k < length bs"
  assumes "next_symbol x = Some X"
  shows "set (items (PredictL k 𝒢 X))  PredictF k 𝒢 I"
proof standard
  fix y
  assume *: "y  set (items (PredictL k 𝒢 X))"
  have "x  bin I k"
    using kth_bin_sub_bins assms(1-4) items_def wf_bin_def wf_bins_def bin_def wf_bin_items_def by fast
  let ?rs = "filter (λr. lhs_rule r = X) ( 𝒢)"
  let ?xs = "map (λr. init_item r k) ?rs"
  have "y  set ?xs"
    using * unfolding PredictL_def items_def by simp
  then obtain r where "y = init_item r k" "lhs_rule r = X" "r  set ( 𝒢)" "next_symbol x = Some (lhs_rule r)"
    using assms(5) by auto
  thus "y  PredictF k 𝒢 I"
    unfolding PredictF_def using x  bin I k by blast
qed

lemma CompleteL_sub_CompleteF:
  assumes "wf_bins 𝒢 ω bs" "bins bs  I" "y  set (items (bs ! k))" "k < length bs"
  assumes "next_symbol y = None"
  shows "set (items (CompleteL k y bs red))  CompleteF k I"
proof standard
  fix x
  assume *: "x  set (items (CompleteL k y bs red))"
  have "y  bin I k"
    using kth_bin_sub_bins assms items_def wf_bin_def wf_bins_def bin_def wf_bin_items_def by fast
  let ?orig = "bs ! start_item y"
  let ?xs = "filter_with_index (λx. next_symbol x = Some (lhs_item y)) (items ?orig)"
  let ?xs' = "map (λ(x, pre). (inc_item x k, PreRed (start_item y, pre, red) [])) ?xs"
  have 0: "start_item y < length bs"
    using wf_bins_def wf_bin_def wf_item_def wf_bin_items_def assms(1,3,4)
    by (metis Orderings.preorder_class.dual_order.strict_trans1 leD not_le_imp_less)
  {
    fix z
    assume *: "z  set (map fst ?xs)"
    have "next_symbol z = Some (lhs_item y)"
      using * by (simp add: filter_with_index_cong_filter)
    moreover have "z  bin I (start_item y)"
      using 0 * assms(1,2) bin_def kth_bin_sub_bins wf_bins_kth_bin filter_with_index_cong_filter
      by (metis (mono_tags, lifting) filter_is_subset in_mono mem_Collect_eq)
    ultimately have "next_symbol z = Some (lhs_item y)" "z  bin I (start_item y)"
      by simp_all
  }
  hence 1: "z  set (map fst ?xs). next_symbol z = Some (lhs_item y)  z  bin I (start_item y)"
    by blast
  obtain z where z: "x = inc_item z k" "z  set (map fst ?xs)"
    using * unfolding CompleteL_def by (auto simp: rev_image_eqI items_def)
  moreover have "next_symbol z = Some (lhs_item y)" "z  bin I (start_item y)"
    using 1 z by blast+
  ultimately show "x  CompleteF k I"
    using y  bin I k assms(5) unfolding CompleteF_def next_symbol_def by (auto split: if_splits)
qed

lemma sound_ScanL:
  assumes "wf_bins 𝒢 ω bs" "bins bs  I" "x  set (items (bs!k))" "k < length bs" "k < length ω"
  assumes "next_symbol x = Some a" "x  I. wf_item 𝒢 ω x" "x  I. sound_item 𝒢 ω x"
  shows "x  set (items (ScanL k ω a x i)). sound_item 𝒢 ω x"
proof standard
  fix y
  assume "y  set (items (ScanL k ω a x i))"
  hence "y  ScanF k ω I"
    by (meson ScanL_sub_ScanF assms(1-6) in_mono)
  thus "sound_item 𝒢 ω y"
    using sound_Scan assms(7,8) unfolding ScanF_def inc_item_def bin_def
    by (smt (verit, best) item.exhaust_sel mem_Collect_eq)
qed

lemma sound_PredictL:
  assumes "wf_bins 𝒢 ω bs" "bins bs  I" "x  set (items (bs!k))" "k < length bs"
  assumes "next_symbol x = Some X" "x  I. wf_item 𝒢 ω x" "x  I. sound_item 𝒢 ω x"
  shows "x  set (items (PredictL k 𝒢 X)). sound_item 𝒢 ω x"
proof standard
  fix y
  assume "y  set (items (PredictL k 𝒢 X))"
  hence "y  PredictF k 𝒢 I"
    by (meson PredictL_sub_PredictF assms(1-5) subsetD)
  thus "sound_item 𝒢 ω y"
    using sound_Predict assms(6,7) unfolding PredictF_def init_item_def bin_def
    by (smt (verit, del_insts) item.exhaust_sel mem_Collect_eq)
qed

lemma sound_CompleteL:
  assumes "wf_bins 𝒢 ω bs" "bins bs  I" "y  set (items (bs!k))" "k < length bs"
  assumes "next_symbol y = None" "x  I. wf_item 𝒢 ω x" "x  I. sound_item 𝒢 ω x"
  shows "x  set (items (CompleteL k y bs i)). sound_item 𝒢 ω x"
proof standard
  fix x
  assume "x  set (items (CompleteL k y bs i))"
  hence "x  CompleteF k I"
    using CompleteL_sub_CompleteF assms(1-5) by blast
  thus "sound_item 𝒢 ω x"
    using sound_Complete assms(6,7) unfolding CompleteF_def inc_item_def bin_def
    by (smt (verit, del_insts) item.exhaust_sel mem_Collect_eq)
qed

lemma sound_EarleyL_bin':
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  assumes "x  bins bs. sound_item 𝒢 ω x"
  shows "x  bins (EarleyL_bin' k 𝒢 ω bs i). sound_item 𝒢 ω x"
  using assms
proof (induction i rule: EarleyL_bin'_induct[OF assms(1), case_names Base CompleteF ScanF Pass PredictF])
  case (CompleteF k 𝒢 ω bs i x)
  let ?bs' = "upd_bins bs k (CompleteL k x bs i)"
  have "x  set (items (bs ! k))"
    using CompleteF.hyps(1,2) by force
  hence "x  set (items (CompleteL k x bs i)). sound_item 𝒢 ω x"
    using sound_CompleteL CompleteF.hyps(3) CompleteF.prems wf_earley_input_elim wf_bins_impl_wf_items by fastforce
  moreover have "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using CompleteF.hyps CompleteF.prems(1) wf_earley_input_CompleteL by blast
  ultimately have "x  bins (EarleyL_bin' k 𝒢 ω ?bs' (i + 1)). sound_item 𝒢 ω x"
    using CompleteF.IH CompleteF.prems(2) length_upd_bins bins_upd_bins wf_earley_input_elim
      Suc_eq_plus1 Un_iff le_imp_less_Suc by metis
  thus ?case
    using CompleteF.hyps by simp
next
  case (ScanF k 𝒢 ω bs i x a)
  let ?bs' = "upd_bins bs (k+1) (ScanL k ω a x i)"
  have "x  set (items (bs ! k))"
    using ScanF.hyps(1,2) by force
  hence "x  set (items (ScanL k ω a x i)). sound_item 𝒢 ω x"
    using sound_ScanL ScanF.hyps(3,5) ScanF.prems(1,2) wf_earley_input_elim wf_bins_impl_wf_items by fast
  moreover have "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using ScanF.hyps ScanF.prems(1) wf_earley_input_ScanL by metis
  ultimately have "x  bins (EarleyL_bin' k 𝒢 ω ?bs' (i + 1)). sound_item 𝒢 ω x"
    using ScanF.IH ScanF.hyps(5) ScanF.prems(2) length_upd_bins bins_upd_bins wf_earley_input_elim
    by (metis UnE add_less_cancel_right)
  thus ?case
    using ScanF.hyps by simp
next
  case (PredictF k 𝒢 ω bs i x a)
  let ?bs' = "upd_bins bs k (PredictL k 𝒢 a)"
  have "x  set (items (bs ! k))"
    using PredictF.hyps(1,2) by force
  hence "x  set (items(PredictL k 𝒢 a)). sound_item 𝒢 ω x"
    using sound_PredictL PredictF.hyps(3) PredictF.prems wf_earley_input_elim wf_bins_impl_wf_items by fast
  moreover have "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using PredictF.hyps PredictF.prems(1) wf_earley_input_PredictL by metis
  ultimately have "x  bins (EarleyL_bin' k 𝒢 ω ?bs' (i + 1)). sound_item 𝒢 ω x"
    using PredictF.IH PredictF.prems(2) length_upd_bins bins_upd_bins wf_earley_input_elim
    by (metis Suc_eq_plus1 UnE)
  thus ?case
    using PredictF.hyps by simp
qed simp_all

lemma sound_EarleyL_bin:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  assumes "x  bins bs. sound_item 𝒢 ω x"
  shows "x  bins (EarleyL_bin k 𝒢 ω bs). sound_item 𝒢 ω x"
  using sound_EarleyL_bin' assms EarleyL_bin_def by metis

lemma EarleyL_bin'_sub_EarleyF_bin:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  assumes "bins bs  I"
  shows "bins (EarleyL_bin' k 𝒢 ω bs i)  EarleyF_bin k 𝒢 ω I"
  using assms
proof (induction i arbitrary: I rule: EarleyL_bin'_induct[OF assms(1), case_names Base CompleteF ScanF Pass PredictF])
  case (Base k 𝒢 ω bs i)
  thus ?case
    using EarleyF_bin_mono by fastforce
next
  case (CompleteF k 𝒢 ω bs i x)
  let ?bs' = "upd_bins bs k (CompleteL k x bs i)"
  have "x  set (items (bs ! k))"
    using CompleteF.hyps(1,2) by force
  hence "bins ?bs'  I  CompleteF k I"
    using CompleteL_sub_CompleteF CompleteF.hyps(3) CompleteF.prems(1,2) bins_upd_bins wf_earley_input_elim by blast
  moreover have "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using CompleteF.hyps CompleteF.prems(1) wf_earley_input_CompleteL by blast
  ultimately have "bins (EarleyL_bin' k 𝒢 ω bs i)  EarleyF_bin k 𝒢 ω (I  CompleteF k I)"
    using CompleteF.IH CompleteF.hyps by simp
  also have "...  EarleyF_bin k 𝒢 ω (EarleyF_bin k 𝒢 ω I)"
    using CompleteF_EarleyF_bin_mono EarleyF_bin_mono EarleyF_bin_sub_mono by (metis Un_subset_iff)
  finally show ?case
    using EarleyF_bin_idem by blast
next
  case (ScanF k 𝒢 ω bs i x a)
  let ?bs' = "upd_bins bs (k+1) (ScanL k ω a x i)"
  have "x  set (items (bs ! k))"
    using ScanF.hyps(1,2) by force
  hence "bins ?bs'  I  ScanF k ω I"
    using ScanL_sub_ScanF ScanF.hyps(3,5) ScanF.prems bins_upd_bins wf_earley_input_elim
    by (metis add_mono1 sup_mono)
  moreover have "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using ScanF.hyps ScanF.prems(1) wf_earley_input_ScanL by metis
  ultimately have "bins (EarleyL_bin' k 𝒢 ω bs i)  EarleyF_bin k 𝒢 ω (I  ScanF k ω I)"
    using ScanF.IH ScanF.hyps by simp
  thus ?case
    using ScanF_EarleyF_bin_mono EarleyF_bin_mono EarleyF_bin_sub_mono EarleyF_bin_idem
    by (metis Un_subset_iff subset_trans)
next
  case (Pass k 𝒢 ω bs i x a)
  thus ?case
    by simp
next
  case (PredictF k 𝒢 ω bs i x a)
  let ?bs' = "upd_bins bs k (PredictL k 𝒢 a)"
  have "x  set (items (bs ! k))"
    using PredictF.hyps(1,2) by force
  hence "bins ?bs'  I  PredictF k 𝒢 I"
    using PredictL_sub_PredictF PredictF.hyps(3) PredictF.prems bins_upd_bins wf_earley_input_elim
    by (metis sup_mono)
  moreover have "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using PredictF.hyps PredictF.prems(1) wf_earley_input_PredictL by metis
  ultimately have "bins (EarleyL_bin' k 𝒢 ω bs i)   EarleyF_bin k 𝒢 ω (I  PredictF k 𝒢 I)"
    using PredictF.IH PredictF.hyps by simp
  thus ?case
    using PredictF_EarleyF_bin_mono EarleyF_bin_mono EarleyF_bin_sub_mono EarleyF_bin_idem
    by (metis Un_subset_iff subset_trans)
qed

lemma EarleyL_bin_sub_EarleyF_bin:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  assumes "bins bs  I"
  shows "bins (EarleyL_bin k 𝒢 ω bs)  EarleyF_bin k 𝒢 ω I"
  using assms EarleyL_bin'_sub_EarleyF_bin EarleyL_bin_def by metis

lemma EarleyL_bins_sub_EarleyF_bins:
  assumes "k  length ω"
  shows "bins (EarleyL_bins k 𝒢 ω)  EarleyF_bins k 𝒢 ω"
  using assms
proof (induction k)
  case 0
  have "(k, 𝒢, ω, InitL 𝒢 ω)  wf_earley_input"
    using assms(1) assms wf_earley_input_InitL by blast
  thus ?case
    by (simp add: InitL_eq_InitF EarleyL_bin_sub_EarleyF_bin assms wf_earley_input_InitL)
next
  case (Suc k)
  have "(Suc k, 𝒢, ω, EarleyL_bins k 𝒢 ω)  wf_earley_input"
    by (simp add: Suc.prems(1) Suc_leD assms wf_earley_input_intro)
  thus ?case
    by (simp add: Suc.IH Suc.prems(1) Suc_leD EarleyL_bin_sub_EarleyF_bin assms)
qed

lemma EarleyL_sub_EarleyF:
  "bins (EarleyL 𝒢 ω)  EarleyF 𝒢 ω"
  using EarleyL_bins_sub_EarleyF_bins EarleyF_def EarleyL_def by (metis dual_order.refl)

theorem soundness_EarleyL:
  assumes "recognizing (bins (EarleyL 𝒢 ω)) 𝒢 ω"
  shows "𝒢  [𝔖 𝒢] * ω"
  using assms EarleyL_sub_EarleyF recognizing_def soundness_EarleyF by (meson subsetD)


subsection ‹Completeness›

lemma bin_bins_upto_bins_eq:
  assumes "wf_bins 𝒢 ω bs" "k < length bs" "i  length (items (bs ! k))" "l  k"
  shows "bin (bins_upto bs k i) l = bin (bins bs) l"
  unfolding bins_upto_def bins_def bin_def using assms nat_less_le
  apply (auto simp: nth_list_update bin_upto_eq_set_items wf_bins_kth_bin items_def)
      apply (metis fst_conv image_eqI order.strict_trans2)
  by (metis fst_conv image_eqI items_def list.set_map wf_bins_kth_bin)

lemma impossible_complete_item:
  assumes "sound_item 𝒢 ω x" "is_complete x"  "start_item x = k" "end_item x = k" "nonempty_derives 𝒢"
  shows False
proof -
  have "𝒢  [lhs_item x] * []"
    using assms(1-4) by (simp add: slice_empty is_complete_def sound_item_def β_item_def)
  thus ?thesis
    by (meson assms(5) nonempty_derives_def)
qed

lemma CompleteF_Un_eq_terminal:
  assumes "next_symbol z = Some a" "a  nonterminals 𝒢" "x  I. wf_item 𝒢 ω x" "wf_item 𝒢 ω z"
  shows "CompleteF k (I  {z}) = CompleteF k I"
proof (rule ccontr)
  assume "CompleteF k (I  {z})  CompleteF k I"
  hence "CompleteF k I  CompleteF k (I  {z})"
    using CompleteF_sub_mono by blast
  then obtain w x y  where *:
    "w  CompleteF k (I  {z})" "w  CompleteF k I" "w = inc_item x k"
    "x  bin (I  {z}) (start_item y)" "y  bin (I  {z}) k"
    "is_complete y" "next_symbol x = Some (lhs_item y)"
    unfolding CompleteF_def by fast
  show False
  proof (cases "x = z")
    case True
    have "lhs_item y  nonterminals 𝒢"
      using *(5,6) assms
      by (auto simp: wf_item_def bin_def lhs_item_def lhs_rule_def next_symbol_def nonterminals_def)
    thus ?thesis
      using True *(7) assms by simp
  next
    case False
    thus ?thesis
      using * assms(1) by (auto simp: next_symbol_def CompleteF_def bin_def)
  qed
qed

lemma CompleteF_Un_eq_nonterminal:
  assumes "x  I. wf_item 𝒢 ω x" "x  I. sound_item 𝒢 ω x"
  assumes "nonempty_derives 𝒢" "wf_item 𝒢 ω z"
  assumes "end_item z = k" "next_symbol z  None"
  shows "CompleteF k (I  {z}) = CompleteF k I"
proof (rule ccontr)
  assume "CompleteF k (I  {z})  CompleteF k I"
  hence "CompleteF k I  CompleteF k (I  {z})"
    using CompleteF_sub_mono by blast
  then obtain x x' y where *:
    "x  CompleteF k (I  {z})" "x  CompleteF k I" "x = inc_item x' k"
    "x'  bin (I  {z}) (start_item y)" "y  bin (I  {z}) k"
    "is_complete y" "next_symbol x' = Some (lhs_item y)"
    unfolding CompleteF_def by fast
  consider (A) "x' = z" | (B) "y = z"
    using *(2-7) CompleteF_def by (auto simp: bin_def; blast)
  thus False
  proof cases
    case A
    have "start_item y = k"
      using *(4) A bin_def assms(5) by (metis (mono_tags, lifting) mem_Collect_eq)
    moreover have "end_item y = k"
      using *(5) bin_def by blast
    moreover have "sound_item 𝒢 ω y"
      using *(5,6) assms(2,6) by (auto simp: bin_def next_symbol_def sound_item_def)
    moreover have "wf_item 𝒢 ω y"
      using *(5) assms(1,4) wf_item_def by (auto simp: bin_def)
    ultimately show ?thesis
      using impossible_complete_item *(6) assms(3) by blast
  next
    case B
    thus ?thesis
      using *(6) assms(6) by (auto simp: next_symbol_def)
  qed
qed

lemma wf_item_in_kth_bin:
  "wf_bins 𝒢 ω bs  x  bins bs  end_item x = k  x  set (items (bs ! k))"
  using bins_bin_exists wf_bins_kth_bin wf_bins_def by blast

lemma CompleteF_bins_upto_eq_bins:
  assumes "wf_bins 𝒢 ω bs" "k < length bs" "i  length (items (bs ! k))"
  shows "CompleteF k (bins_upto bs k i) = CompleteF k (bins bs)"
proof -
  have "l. l  k  bin (bins_upto bs k i) l = bin (bins bs) l"
    using bin_bins_upto_bins_eq[OF assms] by blast
  moreover have "x  bins bs. wf_item 𝒢 ω x"
    using assms(1) wf_bins_impl_wf_items by metis
  ultimately show ?thesis
    unfolding CompleteF_def bin_def wf_item_def wf_item_def by auto
qed

lemma CompleteF_sub_bins_Un_CompleteL:
  assumes "CompleteF k I  bins bs" "I  bins bs" "is_complete z" "wf_bins 𝒢 ω bs" "wf_item 𝒢 ω z"
  shows "CompleteF k (I  {z})  bins bs  set (items (CompleteL k z bs red))"
proof standard
  fix w
  assume "w  CompleteF k (I  {z})"
  then obtain x y where *:
    "w = inc_item x k" "x  bin (I  {z}) (start_item y)" "y  bin (I  {z}) k"
    "is_complete y" "next_symbol x = Some (lhs_item y)"
    unfolding CompleteF_def by blast
  consider (A) "x = z" | (B) "y = z" | "¬ (x = z  y = z)"
    by blast
  thus "w  bins bs  set (items (CompleteL k z bs red))"
  proof cases
    case A
    thus ?thesis
      using *(5) assms(3) by (auto simp: next_symbol_def)
  next
    case B
    let ?orig = "bs ! start_item z"
    let ?is = "filter_with_index (λx. next_symbol x = Some (lhs_item z)) (items ?orig)"
    have "x  bin I (start_item y)"
      using B *(2) *(5) assms(3) by (auto simp: next_symbol_def bin_def)
    moreover have "bin I (start_item z)  set (items (bs ! start_item z))"
      using wf_item_in_kth_bin assms(2,4) bin_def by blast
    ultimately have "x  set (map fst ?is)"
      using *(5) B by (simp add: filter_with_index_cong_filter in_mono)
    thus ?thesis
      unfolding CompleteL_def *(1) by (auto simp: rev_image_eqI items_def)
  next
    case 3
    thus ?thesis
      using * assms(1) CompleteF_def by (auto simp: bin_def; blast)
  qed
qed

lemma CompleteL_eq_start_item:
  "bs ! start_item y = bs' ! start_item y  CompleteL k y bs red = CompleteL k y bs' red"
  by (auto simp: CompleteL_def)

lemma kth_bin_bins_upto_empty:
  assumes "wf_bins 𝒢 ω bs" "k < length bs"
  shows "bin (bins_upto bs k 0) k = {}"
proof -
  {
    fix x
    assume "x  bins_upto bs k 0"
    then obtain l where "x  set (items (bs ! l))" "l < k"
      unfolding bins_upto_def bin_upto_def by blast
    hence "end_item x = l"
      using wf_bins_kth_bin assms by fastforce
    hence "end_item x < k"
      using l < k by blast
  }
  thus ?thesis
    by (auto simp: bin_def)
qed

lemma EarleyL_bin'_mono:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  shows "bins bs  bins (EarleyL_bin' k 𝒢 ω bs i)"
  using assms
proof (induction i rule: EarleyL_bin'_induct[OF assms(1), case_names Base CompleteF ScanF Pass PredictF])
  case (CompleteF k 𝒢 ω bs i x)
  let ?bs' = "upd_bins bs k (CompleteL k x bs i)"
  have wf: "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using CompleteF.hyps CompleteF.prems(1) wf_earley_input_CompleteL by blast
  hence "bins bs  bins ?bs'"
    using length_upd_bins bins_upd_bins wf_earley_input_elim by (metis Un_upper1)
  also have "...  bins (EarleyL_bin' k 𝒢 ω ?bs' (i + 1))"
    using wf CompleteF.IH by blast
  finally show ?case
    using CompleteF.hyps by simp
next
  case (ScanF k 𝒢 ω bs i x a)
  let ?bs' = "upd_bins bs (k+1) (ScanL k ω a x i)"
  have wf: "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using ScanF.hyps ScanF.prems(1) wf_earley_input_ScanL by metis
  hence "bins bs  bins ?bs'"
    using ScanF.hyps(5) length_upd_bins bins_upd_bins wf_earley_input_elim
    by (metis add_mono1 sup_ge1)
  also have "...  bins (EarleyL_bin' k 𝒢 ω ?bs' (i + 1))"
    using wf ScanF.IH by blast
  finally show ?case
    using ScanF.hyps by simp
next
  case (PredictF k 𝒢 ω bs i x a)
  let ?bs' = "upd_bins bs k (PredictL k 𝒢 a)"
  have wf: "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using PredictF.hyps PredictF.prems(1) wf_earley_input_PredictL by metis
  hence "bins bs  bins ?bs'"
    using length_upd_bins bins_upd_bins wf_earley_input_elim by (metis sup_ge1)
  also have "...  bins (EarleyL_bin' k 𝒢 ω ?bs' (i + 1))"
    using wf PredictF.IH by blast
  finally show ?case
    using PredictF.hyps by simp
qed simp_all

lemma EarleyF_bin_step_sub_EarleyL_bin':
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  assumes "EarleyF_bin_step k 𝒢 ω (bins_upto bs k i)  bins bs"
  assumes "x  bins bs. sound_item 𝒢 ω x" "is_word 𝒢 ω" "nonempty_derives 𝒢"
  shows "EarleyF_bin_step k 𝒢 ω (bins bs)  bins (EarleyL_bin' k 𝒢 ω bs i)"
  using assms
proof (induction i rule: EarleyL_bin'_induct[OF assms(1), case_names Base CompleteF ScanF Pass PredictF])
  case (Base k 𝒢 ω bs i)
  have "bin (bins bs) k = bin (bins_upto bs k i) k"
    using Base.hyps Base.prems(1) bin_bins_upto_bins_eq wf_earley_input_elim by blast
  thus ?case
    using ScanF_bin_absorb PredictF_bin_absorb CompleteF_bins_upto_eq_bins wf_earley_input_elim
      Base.hyps Base.prems(1,2,3,5) EarleyF_bin_step_def CompleteF_EarleyF_bin_step_mono
      PredictF_EarleyF_bin_step_mono ScanF_EarleyF_bin_step_mono EarleyL_bin'_mono
    by (metis (no_types, lifting) Un_assoc sup.orderE)
next
  case (CompleteF k 𝒢 ω bs i x)
  let ?bs' = "upd_bins bs k (CompleteL k x bs i)"
  have x: "x  set (items (bs ! k))"
    using CompleteF.hyps(1,2) by auto
  have wf: "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using CompleteF.hyps CompleteF.prems(1) wf_earley_input_CompleteL by blast
  hence sound: "x  set (items (CompleteL k x bs i)). sound_item 𝒢 ω x"
    using sound_CompleteL CompleteF.hyps(3) CompleteF.prems wf_earley_input_elim wf_bins_impl_wf_items x
    by (metis dual_order.refl)
  have "ScanF k ω (bins_upto ?bs' k (i + 1))  bins ?bs'"
  proof -
    have "ScanF k ω (bins_upto ?bs' k (i + 1)) = ScanF k ω (bins_upto ?bs' k i  {items (?bs' ! k) ! i})"
      using CompleteF.hyps(1) bins_upto_Suc_Un length_nth_upd_bin_bins items_def
      by (metis length_map linorder_not_less sup.boundedE sup.order_iff)
    also have "... = ScanF k ω (bins_upto bs k i  {x})"
      using CompleteF.hyps(1,2) CompleteF.prems(1) items_nth_idem_upd_bins bins_upto_kth_nth_idem wf_earley_input_elim
      by (metis dual_order.refl items_def length_map not_le_imp_less)
    also have "...  bins bs  ScanF k ω {x}"
      using CompleteF.prems(2,3) ScanF_Un ScanF_EarleyF_bin_step_mono by fastforce
    also have "... = bins bs"
      using CompleteF.hyps(3) by (auto simp: ScanF_def bin_def)
    finally show ?thesis
      using CompleteF.prems(1) wf_earley_input_elim bins_upd_bins by blast
  qed
  moreover have "PredictF k 𝒢 (bins_upto ?bs' k (i + 1))  bins ?bs'"
  proof -
    have "PredictF k 𝒢 (bins_upto ?bs' k (i + 1)) = PredictF k 𝒢 (bins_upto ?bs' k i  {items (?bs' ! k) ! i})"
      using CompleteF.hyps(1) bins_upto_Suc_Un length_nth_upd_bin_bins
      by (metis dual_order.strict_trans1 items_def length_map not_le_imp_less)
    also have "... = PredictF k 𝒢 (bins_upto bs k i  {x})"
      using CompleteF.hyps(1,2) CompleteF.prems(1) items_nth_idem_upd_bins bins_upto_kth_nth_idem wf_earley_input_elim
      by (metis dual_order.refl items_def length_map not_le_imp_less)
    also have "...  bins bs  PredictF k 𝒢 {x}"
      using CompleteF.prems(2,3) PredictF_Un PredictF_EarleyF_bin_step_mono by blast
    also have "... = bins bs"
      using CompleteF.hyps(3) by (auto simp: PredictF_def bin_def)
    finally show ?thesis
      using CompleteF.prems(1) wf_earley_input_elim bins_upd_bins by blast
  qed
  moreover have "CompleteF k (bins_upto ?bs' k (i + 1))  bins ?bs'"
  proof -
    have "CompleteF k (bins_upto ?bs' k (i + 1)) = CompleteF k (bins_upto ?bs' k i  {items (?bs' ! k) ! i})"
      using bins_upto_Suc_Un length_nth_upd_bin_bins CompleteF.hyps(1)
      by (metis (no_types, opaque_lifting) dual_order.trans items_def length_map not_le_imp_less)
    also have "... = CompleteF k (bins_upto bs k i  {x})"
      using items_nth_idem_upd_bins CompleteF.hyps(1,2) bins_upto_kth_nth_idem CompleteF.prems(1) wf_earley_input_elim
      by (metis dual_order.refl items_def length_map not_le_imp_less)
    also have "...  bins bs  set (items (CompleteL k x bs i))"
      using CompleteF_sub_bins_Un_CompleteL CompleteF.hyps(3) CompleteF.prems(1,2,3) next_symbol_def
        bins_upto_sub_bins wf_bins_kth_bin x CompleteF_EarleyF_bin_step_mono wf_earley_input_elim
      by (smt (verit, best) option.distinct(1) subset_trans)
    finally show ?thesis
      using CompleteF.prems(1) wf_earley_input_elim bins_upd_bins by blast
  qed
  ultimately have "EarleyF_bin_step k 𝒢 ω (bins ?bs')  bins (EarleyL_bin' k 𝒢 ω ?bs' (i+1))"
    using CompleteF.IH CompleteF.prems sound wf EarleyF_bin_step_def bins_upto_sub_bins
      wf_earley_input_elim bins_upd_bins
    by (metis UnE sup.boundedI)
  thus ?case
    using CompleteF.hyps CompleteF.prems(1) EarleyL_bin'_simps(2) EarleyF_bin_step_sub_mono bins_upd_bins wf_earley_input_elim
    by (smt (verit, best) sup.coboundedI2 sup.orderE sup_ge1)
next
  case (ScanF k 𝒢 ω bs i x a)
  let ?bs' = "upd_bins bs (k+1) (ScanL k ω a x i)"
  have x: "x  set (items (bs ! k))"
    using ScanF.hyps(1,2) by auto
  hence sound: "x  set (items (ScanL k ω a x i)). sound_item 𝒢 ω x"
    using sound_ScanL ScanF.hyps(3,5) ScanF.prems(1,2,3) wf_earley_input_elim wf_bins_impl_wf_items x
    by (metis dual_order.refl)
  have wf: "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using ScanF.hyps ScanF.prems(1) wf_earley_input_ScanL by metis
  have "ScanF k ω (bins_upto ?bs' k (i + 1))  bins ?bs'"
  proof -
    have "ScanF k ω (bins_upto ?bs' k (i + 1)) = ScanF k ω (bins_upto ?bs' k i  {items (?bs' ! k) ! i})"
      using bins_upto_Suc_Un ScanF.hyps(1) nth_idem_upd_bins
      by (metis Suc_eq_plus1 items_def length_map lessI less_not_refl not_le_imp_less)
    also have "... = ScanF k ω (bins_upto bs k i  {x})"
      using ScanF.hyps(1,2,5) ScanF.prems(1,2) nth_idem_upd_bins bins_upto_kth_nth_idem wf_earley_input_elim
      by (metis add_mono_thms_linordered_field(1) items_def length_map less_add_one linorder_le_less_linear not_add_less1)
    also have "...  bins bs  ScanF k ω {x}"
      using ScanF.prems(2,3) ScanF_Un ScanF_EarleyF_bin_step_mono by fastforce
    finally have *: "ScanF k ω (bins_upto ?bs' k (i + 1))  bins bs  ScanF k ω {x}" .
    show ?thesis
    proof cases
      assume a1: "ω!k = a"
      hence "ScanF k ω {x} = {inc_item x (k+1)}"
        using ScanF.hyps(1-3,5) ScanF.prems(1,2) wf_earley_input_elim apply (auto simp: ScanF_def bin_def)
        using wf_bins_kth_bin x by blast
      hence "ScanF k ω (bins_upto ?bs' k (i + 1))  bins bs  {inc_item x (k+1)}"
        using * by blast
      also have "... = bins bs  set (items (ScanL k ω a x i))"
        using a1 ScanF.hyps(5) by (auto simp: ScanL_def items_def)
      also have "... = bins ?bs'"
        using ScanF.hyps(5) ScanF.prems(1) wf_earley_input_elim bins_upd_bins by (metis add_mono1)
      finally show ?thesis .
    next
      assume a1: "¬ ω!k = a"
      hence "ScanF k ω {x} = {}"
        using ScanF.hyps(3) by (auto simp: ScanF_def bin_def)
      hence "ScanF k ω (bins_upto ?bs' k (i + 1))  bins bs"
        using * by blast
      also have "...  bins ?bs'"
        using ScanF.hyps(5) ScanF.prems(1) wf_earley_input_elim bins_upd_bins
        by (metis Un_left_absorb add_strict_right_mono subset_Un_eq)
      finally show ?thesis .
    qed
  qed
  moreover have "PredictF k 𝒢 (bins_upto ?bs' k (i + 1))  bins ?bs'"
  proof -
    have "PredictF k 𝒢 (bins_upto ?bs' k (i + 1)) = PredictF k 𝒢 (bins_upto ?bs' k i  {items (?bs' ! k) ! i})"
      using bins_upto_Suc_Un ScanF.hyps(1) nth_idem_upd_bins
      by (metis Suc_eq_plus1 dual_order.refl items_def length_map lessI linorder_not_less)
    also have "... = PredictF k 𝒢 (bins_upto bs k i  {x})"
      using ScanF.hyps(1,2,5) ScanF.prems(1,2) nth_idem_upd_bins bins_upto_kth_nth_idem wf_earley_input_elim
      by (metis add_strict_right_mono items_def le_add1 length_map less_add_one linorder_not_le)
    also have "...  bins bs  PredictF k 𝒢 {x}"
      using ScanF.prems(2,3) PredictF_Un PredictF_EarleyF_bin_step_mono by fastforce
    also have "... = bins bs"
      using ScanF.hyps(3,4) ScanF.prems(1) wf_earley_input_elim
      apply (auto simp: PredictF_def bin_def lhs_rule_def)
      by (smt (verit) UnCI in_set_zipE nonterminals_def zip_map_fst_snd)
    finally show ?thesis
      using ScanF.hyps(5) ScanF.prems(1) by (simp add: bins_upd_bins sup.coboundedI1 wf_earley_input_elim)
  qed
  moreover have "CompleteF k (bins_upto ?bs' k (i + 1))  bins ?bs'"
  proof -
    have "CompleteF k (bins_upto ?bs' k (i + 1)) = CompleteF k (bins_upto ?bs' k i  {items (?bs' ! k) ! i})"
      using bins_upto_Suc_Un ScanF.hyps(1) nth_idem_upd_bins
      by (metis Suc_eq_plus1 items_def length_map lessI less_not_refl not_le_imp_less)
    also have "... = CompleteF k (bins_upto bs k i  {x})"
      using ScanF.hyps(1,2,5) ScanF.prems(1,2) nth_idem_upd_bins bins_upto_kth_nth_idem wf_earley_input_elim
      by (metis add_mono1 items_def length_map less_add_one linorder_not_le not_add_less1)
    also have "... = CompleteF k (bins_upto bs k i)"
      using CompleteF_Un_eq_terminal ScanF.hyps(3,4) ScanF.prems bins_upto_sub_bins subset_iff
        wf_bins_impl_wf_items wf_bins_kth_bin wf_item_def x wf_earley_input_elim
      by (smt (verit, ccfv_threshold))
    finally show ?thesis
      using ScanF.hyps(5) ScanF.prems(1,2,3) CompleteF_EarleyF_bin_step_mono by (auto simp: bins_upd_bins wf_earley_input_elim, blast)
  qed
  ultimately have "EarleyF_bin_step k 𝒢 ω (bins ?bs')  bins (EarleyL_bin' k 𝒢 ω ?bs' (i+1))"
    using ScanF.IH ScanF.prems ScanF.hyps(5) sound wf EarleyF_bin_step_def bins_upto_sub_bins wf_earley_input_elim
      bins_upd_bins by (metis UnE add_mono1 le_supI)
  thus ?case
    using EarleyF_bin_step_sub_mono EarleyL_bin'_simps(3) ScanF.hyps ScanF.prems(1) wf_earley_input_elim bins_upd_bins
    by (smt (verit, ccfv_SIG) add_mono1 sup.cobounded1 sup.coboundedI2 sup.orderE)
next
  case (Pass k 𝒢 ω bs i x a)
  have x: "x  set (items (bs ! k))"
    using Pass.hyps(1,2) by auto
  have "ScanF k ω (bins_upto bs k (i + 1))  bins bs"
    using ScanF_def Pass.hyps(5) by auto
  moreover have "PredictF k 𝒢 (bins_upto bs k (i + 1))  bins bs"
  proof -
    have "PredictF k 𝒢 (bins_upto bs k (i + 1)) = PredictF k 𝒢 (bins_upto bs k i  {items (bs ! k) ! i})"
      using bins_upto_Suc_Un Pass.hyps(1) by (metis items_def length_map not_le_imp_less)
    also have "... = PredictF k 𝒢 (bins_upto bs k i  {x})"
      using Pass.hyps(1,2,5) nth_idem_upd_bins bins_upto_kth_nth_idem by simp
    also have "...  bins bs  PredictF k 𝒢 {x}"
      using Pass.prems(2) PredictF_Un PredictF_EarleyF_bin_step_mono by blast
    also have "... = bins bs"
      using Pass.hyps(3,4) Pass.prems(1) wf_earley_input_elim
      apply (auto simp: PredictF_def bin_def lhs_rule_def)
      by (smt (verit, ccfv_SIG) UnCI fst_conv imageI list.set_map nonterminals_def)
    finally show ?thesis
      using bins_upd_bins Pass.hyps(5) Pass.prems(3) by auto
  qed
  moreover have "CompleteF k (bins_upto bs k (i + 1))  bins bs"
  proof -
    have "CompleteF k (bins_upto bs k (i + 1)) = CompleteF k (bins_upto bs k i  {x})"
      using bins_upto_Suc_Un Pass.hyps(1,2)
      by (metis items_def length_map not_le_imp_less)
    also have "... = CompleteF k (bins_upto bs k i)"
      using CompleteF_Un_eq_terminal Pass.hyps Pass.prems bins_upto_sub_bins subset_iff
        wf_bins_impl_wf_items wf_item_def wf_bins_kth_bin x wf_earley_input_elim by (smt (verit, best))
    finally show ?thesis
      using Pass.prems(1,2) CompleteF_EarleyF_bin_step_mono wf_earley_input_elim by blast
  qed
  ultimately have "EarleyF_bin_step k 𝒢 ω (bins bs)  bins (EarleyL_bin' k 𝒢 ω bs (i+1))"
    using Pass.IH Pass.prems EarleyF_bin_step_def bins_upto_sub_bins wf_earley_input_elim
    by (metis le_sup_iff)
  thus ?case
    using bins_upd_bins Pass.hyps Pass.prems by simp
next
  case (PredictF k 𝒢 ω bs i x a)
  let ?bs' = "upd_bins bs k (PredictL k 𝒢 a)"
  have "k  length ω  ¬ ω!k = a"
    using PredictF.hyps(4) PredictF.prems(4) is_word_def
    by (metis Set.set_insert insert_disjoint(1) not_le_imp_less nth_mem)
  have x: "x  set (items (bs ! k))"
    using PredictF.hyps(1,2) by auto
  hence sound: "x  set (items(PredictL k 𝒢 a)). sound_item 𝒢 ω x"
    using sound_PredictL PredictF.hyps(3) PredictF.prems wf_earley_input_elim wf_bins_impl_wf_items by fast
  have wf: "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using PredictF.hyps PredictF.prems(1) wf_earley_input_PredictL by metis
  have len: "i < length (items (?bs' ! k))"
    using length_nth_upd_bin_bins PredictF.hyps(1)
    by (metis dual_order.strict_trans1 items_def length_map linorder_not_less)
  have "ScanF k ω (bins_upto ?bs' k (i + 1))  bins ?bs'"
  proof -
    have "ScanF k ω (bins_upto ?bs' k (i + 1)) = ScanF k ω (bins_upto ?bs' k i  {items (?bs' ! k) ! i})"
      using PredictF.hyps(1) bins_upto_Suc_Un by (metis items_def len length_map)
    also have "... = ScanF k ω (bins_upto bs k i  {x})"
      using PredictF.hyps(1,2) PredictF.prems(1) items_nth_idem_upd_bins bins_upto_kth_nth_idem wf_earley_input_elim
      by (metis dual_order.refl items_def length_map not_le_imp_less)
    also have "...  bins bs  ScanF k ω {x}"
      using PredictF.prems(2,3) ScanF_Un ScanF_EarleyF_bin_step_mono by fastforce
    also have "... = bins bs"
      using PredictF.hyps(3) length ω  k  ω ! k  a by (auto simp: ScanF_def bin_def)
    finally show ?thesis
      using PredictF.prems(1) wf_earley_input_elim bins_upd_bins by blast
  qed
  moreover have "PredictF k 𝒢 (bins_upto ?bs' k (i + 1))  bins ?bs'"
  proof -
    have "PredictF k 𝒢 (bins_upto ?bs' k (i + 1)) = PredictF k 𝒢 (bins_upto ?bs' k i  {items (?bs' ! k) ! i})"
      using PredictF.hyps(1) bins_upto_Suc_Un by (metis items_def len length_map)
    also have "... = PredictF k 𝒢 (bins_upto bs k i  {x})"
      using PredictF.hyps(1,2) PredictF.prems(1) items_nth_idem_upd_bins bins_upto_kth_nth_idem wf_earley_input_elim
      by (metis dual_order.refl items_def length_map not_le_imp_less)
    also have "...  bins bs  PredictF k 𝒢 {x}"
      using PredictF.prems(2,3) PredictF_Un PredictF_EarleyF_bin_step_mono by fastforce
    also have "... = bins bs  set (items (PredictL k 𝒢 a))"
      using PredictF.hyps PredictF.prems(1-3) wf_earley_input_elim
      apply (auto simp: PredictF_def PredictL_def bin_def items_def)
      using wf_bins_kth_bin x by blast
    finally show ?thesis
      using PredictF.prems(1) wf_earley_input_elim bins_upd_bins by blast
  qed
  moreover have "CompleteF k (bins_upto ?bs' k (i + 1))  bins ?bs'"
  proof -
    have "CompleteF k (bins_upto ?bs' k (i + 1)) = CompleteF k (bins_upto ?bs' k i  {items (?bs' ! k) ! i})"
      using bins_upto_Suc_Un len by (metis items_def length_map)
    also have "... = CompleteF k (bins_upto bs k i  {x})"
      using items_nth_idem_upd_bins PredictF.hyps(1,2) PredictF.prems(1) bins_upto_kth_nth_idem wf_earley_input_elim
      by (metis dual_order.refl items_def length_map not_le_imp_less)
    also have "... = CompleteF k (bins_upto bs k i)"
      using CompleteF_Un_eq_nonterminal PredictF.prems bins_upto_sub_bins PredictF.hyps(3)
        subset_eq wf_bins_kth_bin x wf_bins_impl_wf_items wf_item_def wf_earley_input_elim
      by (smt (verit, ccfv_SIG) option.simps(3))
    also have "...  bins bs"
      using CompleteF_EarleyF_bin_step_mono PredictF.prems(2) by blast
    finally show ?thesis
      using bins_upd_bins PredictF.prems(1,2,3) wf_earley_input_elim by blast
  qed
  ultimately have "EarleyF_bin_step k 𝒢 ω (bins ?bs')  bins (EarleyL_bin' k 𝒢 ω ?bs' (i+1))"
    using PredictF.IH PredictF.prems sound wf EarleyF_bin_step_def bins_upto_sub_bins
      bins_upd_bins wf_earley_input_elim by (metis UnE le_supI)
  hence "EarleyF_bin_step k 𝒢 ω (bins ?bs')  bins (EarleyL_bin' k 𝒢 ω bs i)"
    using PredictF.hyps EarleyL_bin'_simps(5) by simp
  moreover have "EarleyF_bin_step k 𝒢 ω (bins bs)  EarleyF_bin_step k 𝒢 ω (bins ?bs')"
    using EarleyF_bin_step_sub_mono PredictF.prems(1) wf_earley_input_elim bins_upd_bins by (metis Un_upper1)
  ultimately show ?case
    by blast
qed

lemma EarleyF_bin_step_sub_EarleyL_bin:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  assumes "EarleyF_bin_step k 𝒢 ω (bins_upto bs k 0)  bins bs"
  assumes "x  bins bs. sound_item 𝒢 ω x" "is_word 𝒢 ω" "nonempty_derives 𝒢"
  shows "EarleyF_bin_step k 𝒢 ω (bins bs)  bins (EarleyL_bin k 𝒢 ω bs)"
  using assms EarleyF_bin_step_sub_EarleyL_bin' EarleyL_bin_def by metis

lemma bins_eq_items_CompleteL:
  assumes "bins_eq_items as bs" "start_item x < length as"
  shows "items (CompleteL k x as i) = items (CompleteL k x bs i)"
proof -
  let ?orig_a = "as ! start_item x"
  let ?orig_b = "bs ! start_item x"
  have "items ?orig_a = items ?orig_b"
    using assms by (metis (no_types, opaque_lifting) bins_eq_items_def length_map nth_map)
  thus ?thesis
    unfolding CompleteL_def by simp
qed

lemma EarleyL_bin'_bins_eq:
  assumes "(k, 𝒢, ω, as)  wf_earley_input"
  assumes "bins_eq_items as bs" "wf_bins 𝒢 ω as"
  shows "bins_eq_items (EarleyL_bin' k 𝒢 ω as i) (EarleyL_bin' k 𝒢 ω bs i)"
  using assms
proof (induction i arbitrary: bs rule: EarleyL_bin'_induct[OF assms(1), case_names Base CompleteF ScanF Pass PredictF])
  case (Base k 𝒢 ω as i)
  have "EarleyL_bin' k 𝒢 ω as i = as"
    by (simp add: Base.hyps)
  moreover have "EarleyL_bin' k 𝒢 ω bs i = bs"
    using Base.hyps Base.prems(1,2) unfolding bins_eq_items_def
    by (metis EarleyL_bin'_simps(1) length_map nth_map wf_earley_input_elim)
  ultimately show ?case
    using Base.prems(2) by presburger
next
  case (CompleteF k 𝒢 ω as i x)
  let ?as' = "upd_bins as k (CompleteL k x as i)"
  let ?bs' = "upd_bins bs k (CompleteL k x bs i)"
  have k: "k < length as"
    using CompleteF.prems(1) wf_earley_input_elim by blast
  hence wf_x: "wf_item 𝒢 ω x"
    using CompleteF.hyps(1,2) CompleteF.prems(3) wf_bins_kth_bin by fastforce
  have "(k, 𝒢, ω, ?as')  wf_earley_input"
    using CompleteF.hyps CompleteF.prems(1) wf_earley_input_CompleteL by blast
  moreover have "bins_eq_items ?as' ?bs'"
    using CompleteF.hyps(1,2) CompleteF.prems(2,3) bins_eq_items_dist_upd_bins bins_eq_items_CompleteL
      k wf_x wf_bins_kth_bin wf_item_def by (metis dual_order.strict_trans2 leI nth_mem)
  ultimately have "bins_eq_items (EarleyL_bin' k 𝒢 ω ?as' (i + 1)) (EarleyL_bin' k 𝒢 ω ?bs' (i + 1))"
    using CompleteF.IH wf_earley_input_elim by blast
  moreover have "EarleyL_bin' k 𝒢 ω as i = EarleyL_bin' k 𝒢 ω ?as' (i+1)"
    using CompleteF.hyps by simp
  moreover have "EarleyL_bin' k 𝒢 ω bs i = EarleyL_bin' k 𝒢 ω ?bs' (i+1)"
    using CompleteF.hyps CompleteF.prems unfolding bins_eq_items_def
    by (metis EarleyL_bin'_simps(2) map_eq_imp_length_eq nth_map wf_earley_input_elim)
  ultimately show ?case
    by argo
next
  case (ScanF k 𝒢 ω as i x a)
  let ?as' = "upd_bins as (k+1) (ScanL k ω a x i)"
  let ?bs' = "upd_bins bs (k+1) (ScanL k ω a x i)"
  have "(k, 𝒢, ω, ?as')  wf_earley_input"
    using ScanF.hyps ScanF.prems(1) wf_earley_input_ScanL by fast
  moreover have "bins_eq_items ?as' ?bs'"
    using ScanF.hyps(5) ScanF.prems(1,2) bins_eq_items_dist_upd_bins add_mono1 wf_earley_input_elim by metis
  ultimately have "bins_eq_items (EarleyL_bin' k 𝒢 ω ?as' (i + 1)) (EarleyL_bin' k 𝒢 ω ?bs' (i + 1))"
    using ScanF.IH wf_earley_input_elim by blast
  moreover have "EarleyL_bin' k 𝒢 ω as i = EarleyL_bin' k 𝒢 ω ?as' (i+1)"
    using ScanF.hyps by simp
  moreover have "EarleyL_bin' k 𝒢 ω bs i = EarleyL_bin' k 𝒢 ω ?bs' (i+1)"
    using ScanF.hyps ScanF.prems unfolding bins_eq_items_def
    by (smt (verit, ccfv_threshold) EarleyL_bin'_simps(3) length_map nth_map wf_earley_input_elim)
  ultimately show ?case
    by argo
next
  case (Pass k 𝒢 ω as i x a)
  have "bins_eq_items (EarleyL_bin' k 𝒢 ω as (i + 1)) (EarleyL_bin' k 𝒢 ω bs (i + 1))"
    using Pass.prems Pass.IH by blast
  moreover have "EarleyL_bin' k 𝒢 ω as i = EarleyL_bin' k 𝒢 ω as (i+1)"
    using Pass.hyps by simp
  moreover have "EarleyL_bin' k 𝒢 ω bs i = EarleyL_bin' k 𝒢 ω bs (i+1)"
    using Pass.hyps Pass.prems unfolding bins_eq_items_def
    by (metis EarleyL_bin'_simps(4) map_eq_imp_length_eq nth_map wf_earley_input_elim)
  ultimately show ?case
    by argo
next
  case (PredictF k 𝒢 ω as i x a)
  let ?as' = "upd_bins as k (PredictL k 𝒢 a)"
  let ?bs' = "upd_bins bs k (PredictL k 𝒢 a)"
  have "(k, 𝒢, ω, ?as')  wf_earley_input"
    using PredictF.hyps PredictF.prems(1) wf_earley_input_PredictL by fast
  moreover have "bins_eq_items ?as' ?bs'"
    using PredictF.prems(1,2) bins_eq_items_dist_upd_bins wf_earley_input_elim by blast
  ultimately have "bins_eq_items (EarleyL_bin' k 𝒢 ω ?as' (i + 1)) (EarleyL_bin' k 𝒢 ω ?bs' (i + 1))"
    using PredictF.IH wf_earley_input_elim by blast
  moreover have "EarleyL_bin' k 𝒢 ω as i = EarleyL_bin' k 𝒢 ω ?as' (i+1)"
    using PredictF.hyps by simp
  moreover have "EarleyL_bin' k 𝒢 ω bs i = EarleyL_bin' k 𝒢 ω ?bs' (i+1)"
    using PredictF.hyps PredictF.prems unfolding bins_eq_items_def
    by (metis EarleyL_bin'_simps(5) length_map nth_map wf_earley_input_elim)
  ultimately show ?case
    by argo
qed

lemma EarleyL_bin'_idem:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  assumes "i  j" "x  bins bs. sound_item 𝒢 ω x" "nonempty_derives 𝒢"
  shows "bins (EarleyL_bin' k 𝒢 ω (EarleyL_bin' k 𝒢 ω bs i) j) = bins (EarleyL_bin' k 𝒢 ω bs i)"
  using assms
proof (induction i arbitrary: j rule: EarleyL_bin'_induct[OF assms(1), case_names Base CompleteF ScanF Pass PredictF])
  case (CompleteF k 𝒢 ω bs i x)
  let ?bs' = "upd_bins bs k (CompleteL k x bs i)"
  have x: "x  set (items (bs ! k))"
    using CompleteF.hyps(1,2) by auto
  have wf: "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using CompleteF.hyps CompleteF.prems(1) wf_earley_input_CompleteL by blast
  hence "x  set (items (CompleteL k x bs i)). sound_item 𝒢 ω x"
    using sound_CompleteL CompleteF.hyps(3) CompleteF.prems wf_earley_input_elim wf_bins_impl_wf_items x
    by (metis dual_order.refl)
  hence sound: "x  bins ?bs'. sound_item 𝒢 ω x"
    by (metis CompleteF.prems(1,3) UnE bins_upd_bins wf_earley_input_elim)
  show ?case
  proof cases
    assume "i+1  j"
    thus ?thesis
      using wf sound CompleteF EarleyL_bin'_simps(2) by metis
  next
    assume "¬ i+1  j"
    hence "i = j"
      using CompleteF.prems(2) by simp
    have "bins (EarleyL_bin' k 𝒢 ω (EarleyL_bin' k 𝒢 ω bs i) j) = bins (EarleyL_bin' k 𝒢 ω (EarleyL_bin' k 𝒢 ω ?bs' (i+1)) j)"
      using EarleyL_bin'_simps(2) CompleteF.hyps(1-3) by simp
    also have "... = bins (EarleyL_bin' k 𝒢 ω (EarleyL_bin' k 𝒢 ω ?bs' (i+1)) (j+1))"
    proof -
      let ?bs'' = "EarleyL_bin' k 𝒢 ω ?bs' (i+1)"
      have "length (items (?bs'' ! k))  length (items (bs ! k))"
        using length_nth_bin_EarleyL_bin' length_nth_upd_bin_bins order_trans wf CompleteF.hyps CompleteF.prems(1)
        by (smt (verit, ccfv_threshold) EarleyL_bin'_simps(2))
      hence 0: "¬ length (items (?bs'' ! k))  j"
        using i = j CompleteF.hyps(1) by linarith
      have "x = items (?bs' ! k) ! j"
        using i = j items_nth_idem_upd_bins CompleteF.hyps(1,2)
        by (metis items_def length_map not_le_imp_less)
      hence 1: "x = items (?bs'' ! k) ! j"
        using i = j kth_EarleyL_bin'_bins CompleteF.hyps CompleteF.prems(1) EarleyL_bin'_simps(2) leI by metis
      have "bins (EarleyL_bin' k 𝒢 ω ?bs'' j) = bins (EarleyL_bin' k 𝒢 ω (upd_bins ?bs'' k (CompleteL k x ?bs'' i)) (j+1))"
        using EarleyL_bin'_simps(2) 0 1 CompleteF.hyps(1,3) CompleteF.prems(2) i = j by auto
      moreover have "bins_eq_items (upd_bins ?bs'' k (CompleteL k x ?bs'' i)) ?bs''"
      proof -
        have "k < length bs"
          using CompleteF.prems(1) wf_earley_input_elim by blast
        have 0: "set (CompleteL k x bs i) = set (CompleteL k x ?bs'' i)"
        proof (cases "start_item x = k")
          case True
          thus ?thesis
            using impossible_complete_item kth_bin_sub_bins CompleteF.hyps(3) CompleteF.prems wf_earley_input_elim
              wf_bins_kth_bin x next_symbol_def by (metis option.distinct(1) subsetD)
        next
          case False
          hence "start_item x < k"
            using x CompleteF.prems(1) wf_bins_kth_bin wf_item_def nat_less_le by (metis wf_earley_input_elim)
          hence "bs ! start_item x = ?bs'' ! start_item x"
            using False nth_idem_upd_bins nth_EarleyL_bin'_eq wf by metis
          thus ?thesis
            using CompleteL_eq_start_item by metis
        qed
        have "set (items (CompleteL k x bs i))  set (items (?bs' ! k))"
          by (simp add: k < length bs upd_bins_def set_items_upds_bin)
        hence "set (items (CompleteL k x ?bs'' i))  set (items (?bs' ! k))"
          using 0 by (simp add: items_def)
        also have "...  set (items (?bs'' ! k))"
          by (simp add: wf nth_bin_sub_EarleyL_bin')
        finally show ?thesis
          using bins_eq_items_upd_bins by blast
      qed
      moreover have "(k, 𝒢, ω, upd_bins ?bs'' k (CompleteL k x ?bs'' i))  wf_earley_input"
        using wf_earley_input_EarleyL_bin' wf_earley_input_CompleteL CompleteF.hyps CompleteF.prems(1)
          length (items (bs ! k))  length (items (?bs'' ! k)) kth_EarleyL_bin'_bins 0 1 by blast
      ultimately show ?thesis
        using EarleyL_bin'_bins_eq bins_eq_items_imp_eq_bins wf_earley_input_elim by blast
    qed
    also have "... = bins (EarleyL_bin' k 𝒢 ω ?bs' (i + 1))"
      using CompleteF.IH[OF wf _ sound CompleteF.prems(4)] i = j by blast
    finally show ?thesis
      using CompleteF.hyps by simp
  qed
next
  case (ScanF k 𝒢 ω bs i x a)
  let ?bs' = "upd_bins bs (k+1) (ScanL k ω a x i)"
  have x: "x  set (items (bs ! k))"
    using ScanF.hyps(1,2) by auto
  hence "x  set (items (ScanL k ω a x i)). sound_item 𝒢 ω x"
    using sound_ScanL ScanF.hyps(3,5) ScanF.prems(1,2,3) wf_earley_input_elim wf_bins_impl_wf_items x
    by (metis dual_order.refl)
  hence sound: "x  bins ?bs'. sound_item 𝒢 ω x"
    using ScanF.hyps(5) ScanF.prems(1,3) bins_upd_bins wf_earley_input_elim
    by (metis UnE add_less_cancel_right)
  have wf: "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using ScanF.hyps ScanF.prems(1) wf_earley_input_ScanL by metis
  show ?case
  proof cases
    assume "i+1  j"
    thus ?thesis
      using sound ScanF by (metis EarleyL_bin'_simps(3) wf_earley_input_ScanL)
  next
    assume "¬ i+1  j"
    hence "i = j"
      using ScanF.prems(2) by auto
    have "bins (EarleyL_bin' k 𝒢 ω (EarleyL_bin' k 𝒢 ω bs i) j) = bins (EarleyL_bin' k 𝒢 ω (EarleyL_bin' k 𝒢 ω ?bs' (i+1)) j)"
      using ScanF.hyps by simp
    also have "... = bins (EarleyL_bin' k 𝒢 ω (EarleyL_bin' k 𝒢 ω ?bs' (i+1)) (j+1))"
    proof -
      let ?bs'' = "EarleyL_bin' k 𝒢 ω ?bs' (i+1)"
      have "length (items (?bs'' ! k))  length (items (bs ! k))"
        using length_nth_bin_EarleyL_bin' length_nth_upd_bin_bins order_trans ScanF.hyps ScanF.prems(1) EarleyL_bin'_simps(3)
        by (smt (verit, ccfv_SIG))
      hence "bins (EarleyL_bin' k 𝒢 ω ?bs'' j) = bins (EarleyL_bin' k 𝒢 ω (upd_bins ?bs'' (k+1) (ScanL k ω a x i)) (j+1))"
        using i = j kth_EarleyL_bin'_bins nth_idem_upd_bins EarleyL_bin'_simps(3) ScanF.hyps ScanF.prems(1) by (smt (verit, best) leI le_trans)
      moreover have "bins_eq_items (upd_bins ?bs'' (k+1) (ScanL k ω a x i)) ?bs''"
      proof -
        have "k+1 < length bs"
          using ScanF.hyps(5) ScanF.prems wf_earley_input_elim by fastforce+
        hence "set (items (ScanL k ω a x i))  set (items (?bs' ! (k+1)))"
          by (simp add: upd_bins_def set_items_upds_bin)
        also have "...  set (items (?bs'' ! (k+1)))"
          using wf nth_bin_sub_EarleyL_bin' by blast
        finally show ?thesis
          using bins_eq_items_upd_bins by blast
      qed
      moreover have "(k, 𝒢, ω, upd_bins ?bs'' (k+1) (ScanL k ω a x i))  wf_earley_input"
        using wf_earley_input_EarleyL_bin' wf_earley_input_ScanL ScanF.hyps ScanF.prems(1)
          length (items (bs ! k))  length (items (?bs'' ! k)) kth_EarleyL_bin'_bins
        by (smt (verit, ccfv_SIG) EarleyL_bin'_simps(3) linorder_not_le order.trans)
      ultimately show ?thesis
        using EarleyL_bin'_bins_eq bins_eq_items_imp_eq_bins wf_earley_input_elim by blast
    qed
    also have "... = bins (EarleyL_bin' k 𝒢 ω ?bs' (i + 1))"
      using i = j ScanF.IH ScanF.prems ScanF.hyps sound wf_earley_input_ScanL by fast
    finally show ?thesis
      using ScanF.hyps by simp
  qed
next
  case (Pass k 𝒢 ω bs i x a)
  show ?case
  proof cases
    assume "i+1  j"
    thus ?thesis
      using Pass by (metis EarleyL_bin'_simps(4))
  next
    assume "¬ i+1  j"
    show ?thesis
      using Pass EarleyL_bin'_simps(1,4) kth_EarleyL_bin'_bins by (metis Suc_eq_plus1 Suc_leI antisym_conv2 not_le_imp_less)
  qed
next
  case (PredictF k 𝒢 ω bs i x a)
  let ?bs' = "upd_bins bs k (PredictL k 𝒢 a)"
  have x: "x  set (items (bs ! k))"
    using PredictF.hyps(1,2) by auto
  hence "x  set (items(PredictL k 𝒢 a)). sound_item 𝒢 ω x"
    using sound_PredictL PredictF.hyps(3) PredictF.prems wf_earley_input_elim wf_bins_impl_wf_items by fast
  hence sound: "x  bins ?bs'. sound_item 𝒢 ω x"
    using PredictF.prems(1,3) UnE bins_upd_bins wf_earley_input_elim by metis
  have wf: "(k, 𝒢, ω, ?bs')  wf_earley_input"
    using PredictF.hyps PredictF.prems(1) wf_earley_input_PredictL by metis
  have len: "i < length (items (?bs' ! k))"
    using length_nth_upd_bin_bins PredictF.hyps(1) Orderings.preorder_class.dual_order.strict_trans1 linorder_not_less
    by (metis items_def length_map)
  show ?case
  proof cases
    assume "i+1  j"
    thus ?thesis
      using sound wf PredictF by (metis EarleyL_bin'_simps(5))
  next
    assume "¬ i+1  j"
    hence "i = j"
      using PredictF.prems(2) by auto
    have "bins (EarleyL_bin' k 𝒢 ω (EarleyL_bin' k 𝒢 ω bs i) j) = bins (EarleyL_bin' k 𝒢 ω (EarleyL_bin' k 𝒢 ω ?bs' (i+1)) j)"
      using PredictF.hyps by simp
    also have "... = bins (EarleyL_bin' k 𝒢 ω (EarleyL_bin' k 𝒢 ω ?bs' (i+1)) (j+1))"
    proof -
      let ?bs'' = "EarleyL_bin' k 𝒢 ω ?bs' (i+1)"
      have "length (items (?bs'' ! k))  length (items (bs ! k))"
        using length_nth_bin_EarleyL_bin' length_nth_upd_bin_bins order_trans wf
        by (metis (no_types, lifting) items_def length_map)
      hence "bins (EarleyL_bin' k 𝒢 ω ?bs'' j) = bins (EarleyL_bin' k 𝒢 ω (upd_bins ?bs'' k (PredictL k 𝒢 a)) (j+1))"
        using i = j kth_EarleyL_bin'_bins nth_idem_upd_bins EarleyL_bin'_simps(5) PredictF.hyps PredictF.prems(1) length_bins_EarleyL_bin'
          wf_bins_EarleyL_bin' wf_bins_kth_bin wf_item_def x by (smt (verit, ccfv_SIG) linorder_not_le order.trans)
      moreover have "bins_eq_items (upd_bins ?bs'' k (PredictL k 𝒢 a)) ?bs''"
      proof -
        have "k < length bs"
          using wf_earley_input_elim[OF PredictF.prems(1)] by blast
        hence "set (items (PredictL k 𝒢 a))  set (items (?bs' ! k))"
          by (simp add: upd_bins_def set_items_upds_bin)
        also have "...  set (items (?bs'' ! k))"
          using wf nth_bin_sub_EarleyL_bin' by blast
        finally show ?thesis
          using bins_eq_items_upd_bins by blast
      qed
      moreover have "(k, 𝒢, ω, upd_bins ?bs'' k (PredictL k 𝒢 a))  wf_earley_input"
        using wf_earley_input_EarleyL_bin' wf_earley_input_PredictL PredictF.hyps PredictF.prems(1)
          length (items (bs ! k))  length (items (?bs'' ! k)) kth_EarleyL_bin'_bins
        by (smt (verit, best) EarleyL_bin'_simps(5) dual_order.trans not_le_imp_less)
      ultimately show ?thesis
        using EarleyL_bin'_bins_eq bins_eq_items_imp_eq_bins wf_earley_input_elim by blast
    qed
    also have "... = bins (EarleyL_bin' k 𝒢 ω ?bs' (i + 1))"
      using i = j PredictF.IH PredictF.prems sound wf by (metis order_refl)
    finally show ?thesis
      using PredictF.hyps by simp
  qed
qed simp

lemma EarleyL_bin_idem:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  assumes "x  bins bs. sound_item 𝒢 ω x" "nonempty_derives 𝒢"
  shows "bins (EarleyL_bin k 𝒢 ω (EarleyL_bin k 𝒢 ω bs)) = bins (EarleyL_bin k 𝒢 ω bs)"
  using assms EarleyL_bin'_idem EarleyL_bin_def le0 by metis

lemma funpower_EarleyF_bin_step_sub_EarleyL_bin:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  assumes "EarleyF_bin_step k 𝒢 ω (bins_upto bs k 0)  bins bs" "x  bins bs. sound_item 𝒢 ω x"
  assumes "is_word 𝒢 ω" "nonempty_derives 𝒢"
  shows "funpower (EarleyF_bin_step k 𝒢 ω) n (bins bs)  bins (EarleyL_bin k 𝒢 ω bs)"
  using assms
proof (induction n)
  case 0
  thus ?case
    using EarleyL_bin'_mono EarleyL_bin_def by (simp add: EarleyL_bin'_mono EarleyL_bin_def)
next
  case (Suc n)
  have 0: "EarleyF_bin_step k 𝒢 ω (bins_upto (EarleyL_bin k 𝒢 ω bs) k 0)  bins (EarleyL_bin k 𝒢 ω bs)"
    using EarleyL_bin'_mono bins_upto_k0_EarleyL_bin'_eq assms(1,2) EarleyL_bin_def order_trans
    by (metis (no_types, lifting))
  have "funpower (EarleyF_bin_step k 𝒢 ω) (Suc n) (bins bs)  EarleyF_bin_step k 𝒢 ω (bins (EarleyL_bin k 𝒢 ω bs))"
    using EarleyF_bin_step_sub_mono Suc by (metis funpower.simps(2))
  also have "...  bins (EarleyL_bin k 𝒢 ω (EarleyL_bin k 𝒢 ω bs))"
    using EarleyF_bin_step_sub_EarleyL_bin Suc.prems wf_bins_EarleyL_bin sound_EarleyL_bin 0 wf_earley_input_EarleyL_bin by blast
  also have "...  bins (EarleyL_bin k 𝒢 ω bs)"
    using EarleyL_bin_idem Suc.prems by blast
  finally show ?case .
qed

lemma EarleyF_bin_sub_EarleyL_bin:
  assumes "(k, 𝒢, ω, bs)  wf_earley_input"
  assumes "EarleyF_bin_step k 𝒢 ω (bins_upto bs k 0)  bins bs" "x  bins bs. sound_item 𝒢 ω x"
  assumes "is_word 𝒢 ω" "nonempty_derives 𝒢"
  shows "EarleyF_bin k 𝒢 ω (bins bs)  bins (EarleyL_bin k 𝒢 ω bs)"
  using assms funpower_EarleyF_bin_step_sub_EarleyL_bin EarleyF_bin_def elem_limit_simp by fastforce

lemma EarleyF_bins_sub_EarleyL_bins:
  assumes "k  length ω"
  assumes "is_word 𝒢 ω" "nonempty_derives 𝒢"
  shows "EarleyF_bins k 𝒢 ω  bins (EarleyL_bins k 𝒢 ω)"
  using assms
proof (induction k)
  case 0
  hence "EarleyF_bin 0 𝒢 ω (InitF 𝒢)  bins (EarleyL_bin 0 𝒢 ω (InitL 𝒢 ω))"
    using EarleyF_bin_sub_EarleyL_bin InitL_eq_InitF length_bins_InitL InitL_eq_InitF sound_Init bins_upto_empty
      EarleyF_bin_step_empty bins_upto_sub_bins wf_earley_input_InitL wf_earley_input_elim
    by (smt (verit, ccfv_threshold) InitF_sub_Earley basic_trans_rules(31) sound_Earley wf_bins_impl_wf_items)
  thus ?case
    by simp
next
  case (Suc k)
  have wf: "(Suc k, 𝒢, ω, EarleyL_bins k 𝒢 ω)  wf_earley_input"
    by (simp add: Suc.prems(1) Suc_leD assms(2) wf_earley_input_intro)
  have sub: "EarleyF_bin_step (Suc k) 𝒢 ω (bins_upto (EarleyL_bins k 𝒢 ω) (Suc k) 0)  bins (EarleyL_bins k 𝒢 ω)"
  proof -
    have "bin (bins_upto (EarleyL_bins k 𝒢 ω) (Suc k) 0) (Suc k) = {}"
      using kth_bin_bins_upto_empty wf Suc.prems wf_earley_input_elim by blast
    hence "EarleyF_bin_step (Suc k) 𝒢 ω (bins_upto (EarleyL_bins k 𝒢 ω) (Suc k) 0) = bins_upto (EarleyL_bins k 𝒢 ω) (Suc k) 0"
      unfolding EarleyF_bin_step_def ScanF_def CompleteF_def PredictF_def bin_def by blast
    also have "...  bins (EarleyL_bins k 𝒢 ω)"
      using wf Suc.prems bins_upto_sub_bins wf_earley_input_elim by blast
    finally show ?thesis .
  qed
  have sound: "x  bins (EarleyL_bins k 𝒢 ω). sound_item 𝒢 ω x"
    using Suc EarleyL_bins_sub_EarleyF_bins by (metis Suc_leD EarleyF_bins_sub_Earley in_mono sound_Earley wf_Earley)
  have "EarleyF_bins (Suc k) 𝒢 ω  EarleyF_bin (Suc k) 𝒢 ω (bins (EarleyL_bins k 𝒢 ω))"
    using Suc EarleyF_bin_sub_mono by simp
  also have "...  bins (EarleyL_bin (Suc k) 𝒢 ω (EarleyL_bins k 𝒢 ω))"
    using EarleyF_bin_sub_EarleyL_bin wf sub sound Suc.prems by fastforce
  finally show ?case
    by simp
qed

lemma EarleyF_sub_EarleyL:
  assumes "is_word 𝒢 ω" "ε_free 𝒢"
  shows "EarleyF 𝒢 ω  bins (EarleyL 𝒢 ω)"
  using assms EarleyF_bins_sub_EarleyL_bins EarleyF_def EarleyL_def
  by (metis ε_free_impl_nonempty_derives dual_order.refl)

theorem completeness_EarleyL:
  assumes "𝒢  [𝔖 𝒢] * ω" "is_word 𝒢 ω" "ε_free 𝒢"
  shows "recognizing (bins (EarleyL 𝒢 ω)) 𝒢 ω"
  using assms EarleyF_sub_EarleyL EarleyL_sub_EarleyF completeness_EarleyF by (metis subset_antisym)


subsection ‹Correctness›

theorem Earley_eq_EarleyL:
  assumes "is_word 𝒢 ω" "ε_free 𝒢"
  shows "Earley 𝒢 ω = bins (EarleyL 𝒢 ω)"
  using assms EarleyF_sub_EarleyL EarleyL_sub_EarleyF Earley_eq_EarleyF by blast

lemma correctness_recognizer:
  assumes "is_word 𝒢 ω" "ε_free 𝒢"
  shows "recognizer 𝒢 ω  𝒢  [𝔖 𝒢] * ω" (is "?L  ?R")
proof standard
  assume ?L
  then obtain x where "x  set (items (EarleyL 𝒢 ω ! length ω))" "is_finished 𝒢 ω x"
    using assms(1) unfolding recognizer_def by blast
  moreover have "x  bins (EarleyL 𝒢 ω)"
    using assms(2) kth_bin_sub_bins x  set (items (EarleyL 𝒢 ω ! length ω))
    by (metis (no_types, lifting) EarleyL_def dual_order.refl length_EarleyL_bins length_bins_InitL less_add_one subsetD)
  ultimately show ?R
    using recognizing_def soundness_EarleyL by blast
next
  assume ?R
  thus ?L
    using assms wf_item_in_kth_bin recognizing_def is_finished_def
    by (metis completeness_EarleyL recognizer_def wf_bins_EarleyL)
qed

end