section {*FUNCTION\_CFG\_ENFORCE\_ACCESSIBILITY\_cfgLM\_EXTRA*}
theory
  FUNCTION_CFG_ENFORCE_ACCESSIBILITY_cfgLM_EXTRA

imports
  PRJ_12_04_06_04__ENTRY

begin

definition cfgLM_SPEC_CFGEA__Productions :: "
  ('nonterminal, 'event) cfg
  \<Rightarrow> ('nonterminal, 'event) cfg_step_label set"
  where
    "cfgLM_SPEC_CFGEA__Productions G \<equiv>
  {p \<in> cfg_productions G.
  prod_lhs p \<in> cfgLM_accessible_nonterminals G}"

definition F_CFG_APLM__fp_valid_input :: "
  ('nonterminal, 'event) cfg
  \<Rightarrow> 'nonterminal set
  \<Rightarrow> 'nonterminal set
  \<Rightarrow> bool"
  where
    "F_CFG_APLM__fp_valid_input G E N \<equiv>
  valid_cfg G
  \<and> E = cfgSTD_Nonblockingness_nonterminals G
  \<and> N \<subseteq> cfg_nonterminals G"

definition F_CFG_APLM__fp_invariant_01 :: "
  ('nonterminal, 'event) cfg
  \<Rightarrow> 'nonterminal set
  \<Rightarrow> 'nonterminal set
  \<Rightarrow> bool"
  where
    "F_CFG_APLM__fp_invariant_01 G E N \<equiv>
  \<forall>p \<in> cfg_productions G.
    prod_lhs p \<in> N
    \<longrightarrow> (\<forall>w1 A w2.
        prod_rhs p = w1 @ teA A#w2
        \<longrightarrow> setA w1 \<subseteq> E
        \<longrightarrow> A \<in> F_CFG_APLM__fp_one G E N)"

definition F_CFG_APLM__fp_invariant_02 :: "
  ('nonterminal, 'event) cfg
  \<Rightarrow> 'nonterminal set
  \<Rightarrow> 'nonterminal set
  \<Rightarrow> bool"
  where
    "F_CFG_APLM__fp_invariant_02 G E N \<equiv>
  N \<subseteq> cfg_nonterminals G
  \<and> cfg_initial G \<in> N"

definition F_CFG_APLM__fp_invariant_03 :: "
  ('nonterminal, 'event) cfg
  \<Rightarrow> 'nonterminal set
  \<Rightarrow> 'nonterminal set
  \<Rightarrow> bool"
  where
    "F_CFG_APLM__fp_invariant_03 G E N \<equiv>
  N \<subseteq> cfgLM_accessible_nonterminals G"

definition F_CFG_APLM__fp_invariants :: "
  ('nonterminal, 'event) cfg
  \<Rightarrow> 'nonterminal set
  \<Rightarrow> 'nonterminal set
  \<Rightarrow> bool"
  where
    "F_CFG_APLM__fp_invariants G E N \<equiv>
  F_CFG_APLM__fp_invariant_03 G E N
  \<and> F_CFG_APLM__fp_invariant_01 G E N
  \<and> F_CFG_APLM__fp_invariant_02 G E N
  \<and> F_CFG_APLM__fp_valid_input G E N"

lemma F_CFG_APLM__fp_invariants_AT_kleene_starT: "
  F_CFG_APLM__fp_valid_input G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}
  \<Longrightarrow> F_CFG_APLM__fp_invariants G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}"
  apply(simp add: F_CFG_APLM__fp_invariants_def F_CFG_APLM__fp_valid_input_def)
  apply(simp add: F_CFG_APLM__fp_invariant_03_def F_CFG_APLM__fp_invariant_01_def F_CFG_APLM__fp_invariant_02_def )
  apply(clarsimp)
  apply(rule conjI)
   apply(simp add: cfgLM_accessible_nonterminals_def)
   apply(rule_tac
      x="der1 \<lparr>cfg_conf=[teA (cfg_initial G)]\<rparr>"
      in exI)
   apply(rule conjI)
    apply(simp add: cfgLM.derivation_initial_def)
    apply(rule conjI)
     apply(rule cfgLM.der1_is_derivation)
    apply(simp add: der1_def)
    apply(simp add: cfg_initial_configurations_def)
    apply(simp add: cfg_configurations_def valid_cfg_def)
   apply(simp add: get_configuration_def der1_def)
   apply(rule_tac
      x="[]"
      in exI)
   apply(clarsimp)
  apply(clarsimp)
  apply(rename_tac p w1 A w2)(*strict*)
  apply(simp add: F_CFG_APLM__fp_one_def)
  apply(clarsimp)
  apply(force)
  done

lemma F_CFG_APLM_termLem1: "
  F_CFG_APLM__fp_one G E N \<noteq> N
  \<Longrightarrow> F_CFG_APLM__fp_valid_input G E N
  \<Longrightarrow> F_CFG_APLM__fp_valid_input G E (F_CFG_APLM__fp_one G E N)"
  apply(unfold F_CFG_APLM__fp_valid_input_def F_CFG_APLM__fp_one_def)
  apply(auto)
  apply(rename_tac x p w1 w2 xa pa w1a w2a)(*strict*)
  apply(simp add: valid_cfg_def)
  apply(clarsimp)
  apply(erule_tac
      x="p"
      in ballE)
   apply(rename_tac x p w1 w2 xa pa w1a w2a)(*strict*)
   prefer 2
   apply(force)
  apply(rename_tac x p w1 w2 xa pa w1a w2a)(*strict*)
  apply(clarsimp)
  apply (metis elemInsetA nset_mp)
  done

lemma F_CFG_APLM__fp_one_preserves_F_CFG_APLM__fp_valid_input: "
  F_CFG_APLM__fp_valid_input G E N
  \<Longrightarrow> F_CFG_APLM__fp_valid_input G E (F_CFG_APLM__fp_one G E N)"
  apply(case_tac "F_CFG_APLM__fp_one G E N = N")
   apply(clarsimp)
  apply(rule F_CFG_APLM_termLem1)
   apply(auto)
  done

lemma F_CFG_APLM_sumSmaller: "
  F_CFG_APLM__fp_one G E N \<noteq> N
  \<Longrightarrow> F_CFG_APLM__fp_valid_input G E N
  \<Longrightarrow> card (cfg_nonterminals G - F_CFG_APLM__fp_one G E N) < card (cfg_nonterminals G - N)"
  apply(rule card_diff)
     apply(simp add: F_CFG_APLM__fp_one_def)
    apply(force)
   apply(simp add: F_CFG_APLM__fp_valid_input_def valid_cfg_def)
  apply(simp add: F_CFG_APLM__fp_valid_input_def F_CFG_APLM__fp_one_def)
  apply(clarsimp)
  apply(rename_tac x p w1 w2)(*strict*)
  apply(simp add: valid_cfg_def)
  apply(clarsimp)
  apply(erule_tac
      x="p"
      in ballE)
   apply(rename_tac x p w1 w2)(*strict*)
   prefer 2
   apply(force)
  apply(rename_tac x p w1 w2)(*strict*)
  apply(clarsimp)
  apply (metis elemInsetA nset_mp)
  done

lemma F_CFG_APLM__fp_one_TRANSFER_TRANSFERS_SOUND: "
  F_CFG_APLM__fp_valid_input G E (F_CFG_APLM__fp_one G E N)
  \<Longrightarrow> F_CFG_APLM__fp_valid_input G E N
  \<Longrightarrow> F_CFG_APLM__fp_invariants G E N
  \<Longrightarrow> F_CFG_APLM__fp_invariant_03 G E (F_CFG_APLM__fp_one G E N)"
  apply(subgoal_tac "F_CFG_APLM__fp_invariant_03 G E N")
   defer
   apply(simp add: F_CFG_APLM__fp_invariants_def)
  apply(subgoal_tac "valid_cfg G")
   defer
   apply(simp add: F_CFG_APLM__fp_invariants_def F_CFG_APLM__fp_valid_input_def)
  apply(simp add: F_CFG_APLM__fp_invariant_03_def)
  apply(simp add: F_CFG_APLM__fp_one_def)
  apply(simp add: cfgLM_accessible_nonterminals_def)
  apply(clarsimp)
  apply(rename_tac x p w1 w2)(*strict*)
  apply(rule conjI)
   apply(rename_tac x p w1 w2)(*strict*)
   apply(simp add: valid_cfg_def)
   apply(clarsimp)
   apply(erule_tac
      x="p"
      in ballE)
    apply(rename_tac x p w1 w2)(*strict*)
    prefer 2
    apply(force)
   apply(rename_tac x p w1 w2)(*strict*)
   apply(clarsimp)
   apply (metis elemInsetA nset_mp)
  apply(rename_tac x p w1 w2)(*strict*)
  apply(subgoal_tac "prod_lhs p \<in> {A \<in> cfg_nonterminals G. \<exists>d. cfgLM.derivation_initial G d \<and> (\<exists>n c. get_configuration (d n) = Some c \<and> (\<exists>w1 w2. cfg_conf c = liftB w1 @ teA A # w2))}")
   apply(rename_tac x p w1 w2)(*strict*)
   prefer 2
   apply(force)
  apply(rename_tac x p w1 w2)(*strict*)
  apply(thin_tac "N \<subseteq> {A \<in> cfg_nonterminals G. \<exists>d. cfgLM.derivation_initial G d \<and> (\<exists>n c. get_configuration (d n) = Some c \<and> (\<exists>w1 w2. cfg_conf c = liftB w1 @ teA A # w2))}")
  apply(rename_tac x p w1 w2)(*strict*)
  apply(clarsimp)
  apply(rename_tac x p w1 w2 d n c w1a w2a)(*strict*)
  apply(case_tac "d n")
   apply(rename_tac x p w1 w2 d n c w1a w2a)(*strict*)
   apply(simp add: get_configuration_def)
  apply(rename_tac x p w1 w2 d n c w1a w2a a)(*strict*)
  apply(case_tac a)
  apply(rename_tac x p w1 w2 d n c w1a w2a a option b)(*strict*)
  apply(simp add: get_configuration_def)
  apply(clarsimp)
  apply(rename_tac x p w1 w2 d n c w1a w2a option)(*strict*)
  apply(rename_tac e)
  apply(rename_tac x p w1 w2 d n c w1a w2a e)(*strict*)
  apply(case_tac c)
  apply(rename_tac x p w1 w2 d n c w1a w2a e cfg_confa)(*strict*)
  apply(clarsimp)
  apply(rename_tac x p w1 w2 d n w1a w2a e)(*strict*)
  apply(simp add: F_CFG_APLM__fp_valid_input_def)
  apply(clarsimp)
  apply(thin_tac "{u.
        \<exists>p. p \<in> cfg_productions G \<and>
            prod_lhs p \<in> N \<and>
            (\<exists>w1. (\<exists>w2. prod_rhs p = w1 @ teA u # w2) \<and>
                  setA w1 \<subseteq> cfgSTD_Nonblockingness_nonterminals G)}
       \<subseteq> cfg_nonterminals G")
  apply(rename_tac x p w1 w2 d n w1a w2a e)(*strict*)
  apply(subgoal_tac "\<exists>d w'. cfgSTD.derivation_from_to G d {pair None \<lparr>cfg_conf = w1\<rparr>} {y. \<exists>x. y = pair x \<lparr>cfg_conf = w'\<rparr>} \<and> setA w' = {}")
   apply(rename_tac x p w1 w2 d n w1a w2a e)(*strict*)
   prefer 2
   apply(rule canElimCombine)
    apply(rename_tac x p w1 w2 d n w1a w2a e)(*strict*)
    apply(force)
   apply(rename_tac x p w1 w2 d n w1a w2a e)(*strict*)
   apply(force)
  apply(rename_tac x p w1 w2 d n w1a w2a e)(*strict*)
  apply(clarsimp)
  apply(rename_tac x p w1 w2 d n w1a w2a e da w')(*strict*)
  apply(simp add: cfgSTD.derivation_from_to_def cfgSTD.derivation_from_def cfgSTD.derivation_to_def)
  apply(clarsimp)
  apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa)(*strict*)
  apply(case_tac "da 0")
   apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa)(*strict*)
   apply(clarsimp)
  apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa a)(*strict*)
  apply(clarsimp)
  apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa)(*strict*)
  apply(subgoal_tac "\<exists>d' e. cfgLM.derivation G d' \<and> maximum_of_domain d' na \<and> d' 0 = Some (pair None \<lparr>cfg_conf=w1\<rparr>) \<and> d' na = Some (pair e \<lparr>cfg_conf=w'\<rparr>)")
   apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa)(*strict*)
   prefer 2
   apply(rule cfg_derivation_can_be_translated_to_cfgLM_derivation)
        apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa)(*strict*)
        apply(force)
       apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa)(*strict*)
       apply(force)
      apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa)(*strict*)
      apply(simp add: maximum_of_domain_def)
     apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa)(*strict*)
     apply(force)
    apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa)(*strict*)
    apply(force)
   apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa)(*strict*)
   apply(force)
  apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa)(*strict*)
  apply(clarsimp)
  apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
  apply(rule_tac
      x="derivation_append (derivation_append d (der2 \<lparr>cfg_conf = liftB w1a @ teA (prod_lhs p) # w2a\<rparr> p \<lparr>cfg_conf = liftB w1a @ (prod_rhs p) @ w2a\<rparr>) n) (derivation_map d' (\<lambda>c. \<lparr>cfg_conf=liftB w1a@(cfg_conf c)@(teA x#w2)@w2a\<rparr>)) (Suc n)"
      in exI)
  apply(rule conjI)
   apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
   apply(rule cfgLM.derivation_append_preserves_derivation_initial)
     apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
     apply(force)
    apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
    apply(rule cfgLM.derivation_append_preserves_derivation_initial)
      apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
      apply(force)
     apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
     apply(force)
    apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
    apply(rule cfgLM.derivation_append_preserves_derivation)
      apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
      apply(rule cfgLM.derivation_initial_is_derivation)
      apply(force)
     apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
     apply(rule cfgLM.der2_is_derivation)
     apply(simp add: cfgLM_step_relation_def)
     apply(rule_tac
      x="liftB w1a"
      in exI)
     apply(clarsimp)
     apply (metis setA_liftB)
    apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
    apply(clarsimp)
    apply(simp add: der2_def)
   apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
   apply(rule cfgLM.derivation_append_preserves_derivation)
     apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
     apply(rule cfgLM.derivation_append_preserves_derivation)
       apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
       apply(rule cfgLM.derivation_initial_is_derivation)
       apply(force)
      apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
      apply(rule cfgLM.der2_is_derivation)
      apply(simp add: cfgLM_step_relation_def)
      apply(rule_tac
      x="liftB w1a"
      in exI)
      apply(clarsimp)
      apply (metis setA_liftB)
     apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
     apply(clarsimp)
     apply(simp add: der2_def)
    apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
    apply(rule cfgLM.derivation_map_preserves_derivation2)
     apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
     apply(force)
    apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
    apply(clarsimp)
    apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea a eb b)(*strict*)
    apply(simp add: cfgLM_step_relation_def)
    apply(clarsimp)
    apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea a eb b l r)(*strict*)
    apply(rule_tac
      x="liftB w1a@l"
      in exI)
    apply(clarsimp)
    apply(simp add: setAConcat)
    apply (metis setA_liftB)
   apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
   apply(simp add: der2_def derivation_append_def derivation_map_def)
  apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
  apply(rule_tac
      x="n+Suc 0+na"
      in exI)
  apply(clarsimp)
  apply(simp add: der2_def derivation_append_def derivation_map_def)
  apply(case_tac na)
   apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea)(*strict*)
   apply(clarsimp)
   apply(rename_tac x p w2 d n w1a w2a e da w' d')(*strict*)
   apply(rule_tac
      x="w1a@(filterB w')"
      in exI)
   apply(rule_tac
      x="w2@w2a"
      in exI)
   apply(clarsimp)
   apply (metis liftBDeConv2 liftB_commutes_over_concat)
  apply(rename_tac x p w1 w2 d n w1a w2a e da w' na xa d' ea nat)(*strict*)
  apply(clarsimp)
  apply(rename_tac x p w1 w2 d n w1a w2a e da w' xa d' ea nat)(*strict*)
  apply(rule_tac
      x="w1a@(filterB w')"
      in exI)
  apply(rule_tac
      x="w2@w2a"
      in exI)
  apply(clarsimp)
  apply (metis liftBDeConv2 liftB_commutes_over_concat)
  done

lemma F_CFG_APLM__fp_one_TRANSFER_TRANSFERS_EXTRA_01: "
  F_CFG_APLM__fp_valid_input G E (F_CFG_APLM__fp_one G E N)
  \<Longrightarrow> F_CFG_APLM__fp_valid_input G E N
  \<Longrightarrow> F_CFG_APLM__fp_invariants G E N
  \<Longrightarrow> F_CFG_APLM__fp_invariant_01 G E (F_CFG_APLM__fp_one G E N)"
  apply(simp add: F_CFG_APLM__fp_invariant_01_def)
  apply(clarsimp)
  apply(rename_tac p w1 A w2)(*strict*)
  apply(simp add: F_CFG_APLM__fp_one_def)
  apply(erule disjE)
   apply(rename_tac p w1 A w2)(*strict*)
   apply(rule disjI2)
   apply(rule disjI1)
   apply(rule_tac
      x="p"
      in exI)
   apply(rename_tac p w1 A w2)(*strict*)
   apply(clarsimp)
   apply(rule_tac
      x="w1"
      in exI)
   apply(clarsimp)
  apply(rename_tac p w1 A w2)(*strict*)
  apply(rule disjI2)
  apply(rule disjI2)
  apply(clarsimp)
  apply(rename_tac p w1 A w2 pa w1a w2a)(*strict*)
  apply(rule_tac
      x="p"
      in exI)
  apply(rename_tac p w1 A w2 pa w1a w2a)(*strict*)
  apply(clarsimp)
  apply(rule conjI)
   apply(rename_tac p w1 A w2 pa w1a w2a)(*strict*)
   apply(rule disjI2)
   apply(rule_tac
      x="pa"
      in exI)
   apply(rename_tac p w1 A w2 pa w1a w2a)(*strict*)
   apply(clarsimp)
   apply(rule_tac
      x="w1a"
      in exI)
   apply(clarsimp)
  apply(rename_tac p w1 A w2 pa w1a w2a)(*strict*)
  apply(force)
  done

lemma F_CFG_APLM__fp_one_TRANSFER_TRANSFERS_EXTRA_02: "
  F_CFG_APLM__fp_valid_input G E (F_CFG_APLM__fp_one G E N)
  \<Longrightarrow> F_CFG_APLM__fp_valid_input G E N
  \<Longrightarrow> F_CFG_APLM__fp_invariants G E N
  \<Longrightarrow> F_CFG_APLM__fp_invariant_02 G E (F_CFG_APLM__fp_one G E N)"
  apply(simp add: F_CFG_APLM__fp_invariant_02_def F_CFG_APLM__fp_invariants_def)
  apply(auto)
   apply(rename_tac x)(*strict*)
   apply(simp add: F_CFG_APLM__fp_one_def)
   apply(auto)
   apply(rename_tac x p w1 w2)(*strict*)
   apply(simp add: F_CFG_APLM__fp_valid_input_def valid_cfg_def)
   apply (metis elemInsetA nset_mp)
  apply(simp add: F_CFG_APLM__fp_one_def)
  done

lemma F_CFG_APLM__fp_one_TRANSFER_TRANSFERS_ALL: "
  F_CFG_APLM__fp_valid_input G E (F_CFG_APLM__fp_one G E N)
  \<Longrightarrow> F_CFG_APLM__fp_valid_input G E N
  \<Longrightarrow> F_CFG_APLM__fp_invariants G E N
  \<Longrightarrow> F_CFG_APLM__fp_invariants G E (F_CFG_APLM__fp_one G E N)"
  apply(simp (no_asm) add: F_CFG_APLM__fp_invariants_def)
  apply(rule conjI)
   apply(rule F_CFG_APLM__fp_one_TRANSFER_TRANSFERS_SOUND)
     apply(blast)+
  apply(rule conjI)
   apply(rule F_CFG_APLM__fp_one_TRANSFER_TRANSFERS_EXTRA_01)
     apply(blast+)
  apply(rule conjI)
   apply(rule F_CFG_APLM__fp_one_TRANSFER_TRANSFERS_EXTRA_02)
     apply(blast+)
  done

lemma F_CFG_APLM__fp_Meta_Lift: "
  F_CFG_APLM__fp_valid_input G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}
  \<Longrightarrow> (\<And>G E N. F_CFG_APLM__fp_valid_input G E (F_CFG_APLM__fp_one G E N) \<Longrightarrow> F_CFG_APLM__fp_valid_input G E N \<Longrightarrow> F_CFG_APLM__fp_invariants G E N \<Longrightarrow> P (F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N)) E G  \<Longrightarrow> P (F_CFG_APLM__fp G E N) E G)
  \<Longrightarrow> (\<And>G E N. F_CFG_APLM__fp_one G E N = N \<Longrightarrow> F_CFG_APLM__fp_valid_input G E N \<Longrightarrow> F_CFG_APLM__fp_invariants G E N  \<Longrightarrow> P (F_CFG_APLM__fp G E N) E G)
  \<Longrightarrow> P (F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}) (cfgSTD_Nonblockingness_nonterminals G) G"
  apply(subgoal_tac "(\<lambda>G E N. F_CFG_APLM__fp_invariants G E N \<longrightarrow> (P (F_CFG_APLM__fp G E N) E G)) G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}")
   apply(erule impE)
    prefer 2
    apply(blast)
   apply(rule F_CFG_APLM__fp_invariants_AT_kleene_starT)
   apply(blast)
  apply(subgoal_tac "(\<lambda>(G,E,N). F_CFG_APLM__fp_invariants G E N \<longrightarrow> (P (F_CFG_APLM__fp G E N) E G)) (G,(cfgSTD_Nonblockingness_nonterminals G),{cfg_initial G})")
   apply(blast)
  apply(rule_tac
      TERM_ARGS_TEST = "\<lambda>(G,E,N). F_CFG_APLM__fp_valid_input G E N"
      and RECURSIVE_COND = "\<lambda>(G,E,N). F_CFG_APLM__fp_one G E N\<noteq>N"
      and MODIFY_ARGS_FOR_REC_CALL = "\<lambda>(G,E,N). (G,E,F_CFG_APLM__fp_one G E N)"
      and MEASURE = "\<lambda>(G,E,N). card (cfg_nonterminals G - N)"
      and TERM_FUN = "(\<lambda>(G,E,N). F_CFG_APLM__fp_invariants G E N \<longrightarrow> (P (F_CFG_APLM__fp G E N) E G))"
      and y = "(G,(cfgSTD_Nonblockingness_nonterminals G),{cfg_initial G})"
      in partial_termination_wf)
      apply(rule allI)
      apply(rename_tac x)(*strict*)
      apply(clarify)
      apply(rename_tac a aa b)(*strict*)
      apply(thin_tac "F_CFG_APLM__fp_valid_input G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}")
      apply(rename_tac G E N)
      apply(rename_tac G E N)(*strict*)
      apply(rule F_CFG_APLM__fp_one_preserves_F_CFG_APLM__fp_valid_input)
      apply(blast)
     apply(thin_tac "F_CFG_APLM__fp_valid_input G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}")
     apply(clarsimp)
     apply(rename_tac a aa b)(*strict*)
     apply(rename_tac G E N)
     apply(rename_tac G E N)(*strict*)
     apply(rule F_CFG_APLM_sumSmaller)
      apply(rename_tac G E N)(*strict*)
      apply(force)
     apply(rename_tac G E N)(*strict*)
     apply(force)
    apply(force)
   prefer 2
   apply(clarsimp)
  apply(clarsimp)
  apply(rename_tac a aa b)(*strict*)
  apply(erule impE)
   apply(rename_tac a aa b)(*strict*)
   apply(rule F_CFG_APLM__fp_one_TRANSFER_TRANSFERS_ALL)
     apply(rename_tac a aa b)(*strict*)
     apply(blast)+
  done

lemma F_CFG_APLM__fp_termination: "
  F_CFG_APLM__fp_valid_input G E N
  \<Longrightarrow> F_CFG_APLM__fp_dom (G, E, N)"
  apply(rule_tac
      TERM_ARGS_TEST = "\<lambda>(G,E,N). F_CFG_APLM__fp_valid_input G E N"
      and RECURSIVE_COND = "\<lambda>(G,E,N). F_CFG_APLM__fp_one G E N\<noteq>N"
      and MODIFY_ARGS_FOR_REC_CALL = "\<lambda>(G,E,N). (G,E,F_CFG_APLM__fp_one G E N)"
      and MEASURE = "\<lambda>(G,E,f). card (cfg_nonterminals G - f)"
      in partial_termination_wf)
      apply(clarsimp)
      apply(rename_tac a aa b)(*strict*)
      apply(rule F_CFG_APLM_termLem1)
       apply(rename_tac a aa b)(*strict*)
       apply(blast,blast)
     defer
     apply(clarsimp)
     apply(rename_tac a aa b)(*strict*)
     apply(rule F_CFG_APLM__fp.domintros,blast,blast)
    apply(clarsimp)
    apply(rename_tac a aa b)(*strict*)
    apply(rule F_CFG_APLM__fp.domintros,blast,blast)
   apply(blast)
  apply(clarsimp)
  apply(rename_tac a aa b)(*strict*)
  apply(rule F_CFG_APLM_sumSmaller)
   apply(rename_tac a aa b)(*strict*)
   apply(blast)
  apply(rename_tac a aa b)(*strict*)
  apply(blast)
  done

lemma F_CFG_APLM_F_CFG_APLM__fp_invariant_02_unfold: "
  F_CFG_APLM__fp_valid_input G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}
  \<Longrightarrow> F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G} \<subseteq> cfg_nonterminals G \<and> cfg_initial G \<in> F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}"
  apply(rule F_CFG_APLM__fp_Meta_Lift)
    apply(blast)
   apply(rename_tac Ga E N)(*strict*)
   defer
   apply(thin_tac "F_CFG_APLM__fp_valid_input G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}")
   apply(rename_tac G E N)(*strict*)
   apply(subgoal_tac "F_CFG_APLM__fp G E N=N")
    apply(rename_tac G E N)(*strict*)
    apply(clarsimp)
    apply(simp add: F_CFG_APLM__fp_invariants_def F_CFG_APLM__fp_invariant_02_def)
   apply(rename_tac G E N)(*strict*)
   apply(rule_tac
      s="(if F_CFG_APLM__fp_one G E N = N then N else F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N))"
      and t="F_CFG_APLM__fp G E N"
      in ssubst)
    apply(rename_tac G E N)(*strict*)
    apply(rule F_CFG_APLM__fp.psimps)
    apply(rule F_CFG_APLM__fp_termination)
    apply(blast)
   apply(rename_tac G E N)(*strict*)
   apply(clarsimp)
  apply(rename_tac Ga E N)(*strict*)
  apply(thin_tac "F_CFG_APLM__fp_valid_input G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}")
  apply(rename_tac G E N)(*strict*)
  apply(case_tac "F_CFG_APLM__fp_one G E N = N")
   apply(rename_tac G E N)(*strict*)
   apply(clarsimp)
  apply(rename_tac G E N)(*strict*)
  apply(rule_tac
      t = "F_CFG_APLM__fp G E N"
      and s = "(if F_CFG_APLM__fp_one G E N = N then N else F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N))"
      in ssubst)
   apply(rename_tac G E N)(*strict*)
   apply(rule F_CFG_APLM__fp.psimps)
   apply(rule F_CFG_APLM__fp_termination)
   apply(blast)
  apply(rename_tac G E N)(*strict*)
  apply(clarsimp)
  done

lemma F_CFG_APLM_F_CFG_APLM__fp_invariant_01_unfold: "
  F_CFG_APLM__fp_valid_input G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}
  \<Longrightarrow> \<forall>p\<in> cfg_productions G. (prod_lhs p \<in> F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}) \<longrightarrow> (\<forall>w1 A w2. prod_rhs p = w1 @ teA A # w2 \<longrightarrow> setA w1 \<subseteq> (cfgSTD_Nonblockingness_nonterminals G) \<longrightarrow> A \<in> F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G})"
  apply(rule_tac
      P="\<lambda>S E G. \<forall>p\<in> cfg_productions G. prod_lhs p \<in> S \<longrightarrow> (\<forall>w1 A w2. prod_rhs p = w1 @ teA A # w2 \<longrightarrow> setA w1 \<subseteq> E \<longrightarrow> A \<in> S)"
      in F_CFG_APLM__fp_Meta_Lift)
    apply(blast)
   apply(rename_tac Ga E N)(*strict*)
   defer
   apply(thin_tac "F_CFG_APLM__fp_valid_input G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}")
   apply(rename_tac G E N)(*strict*)
   apply(rename_tac G E N)
   apply(clarsimp)
   apply(rename_tac G E N p w1 A w2)(*strict*)
   apply(subgoal_tac "F_CFG_APLM__fp G E N=N")
    apply(rename_tac G E N p w1 A w2)(*strict*)
    apply(clarsimp)
    apply(simp add: F_CFG_APLM__fp_invariants_def F_CFG_APLM__fp_invariant_01_def)
    apply(rule_tac
      s="(if F_CFG_APLM__fp_one G E N = N then N else F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N))"
      and t="F_CFG_APLM__fp G E N"
      in ssubst)
     apply(rename_tac G E N p w1 A w2)(*strict*)
     apply(rule F_CFG_APLM__fp.psimps)
     apply(rule F_CFG_APLM__fp_termination)
     apply(blast)
    apply(rename_tac G E N p w1 A w2)(*strict*)
    apply(clarsimp)
    apply(rename_tac G E N p w1 A w2)(*strict*)
    apply(erule_tac
      x="p"
      in ballE)
     apply(rename_tac G E N p w1 A w2)(*strict*)
     prefer 2
     apply(force)
    apply(rename_tac G E N p w1 A w2)(*strict*)
    apply(clarsimp)
    apply(erule_tac
      x="w1"
      in allE)
    apply(clarsimp)
   apply(rename_tac G E N p w1 A w2)(*strict*)
   apply(rule_tac
      P = "\<lambda>x. x = N"
      and t = "F_CFG_APLM__fp G E N"
      and s = "(if F_CFG_APLM__fp_one G E N = N then N else F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N))"
      in ssubst)
    apply(rename_tac G E N p w1 A w2)(*strict*)
    apply(rule F_CFG_APLM__fp.psimps)
    apply(rule F_CFG_APLM__fp_termination)
    apply(blast)
   apply(rename_tac G E N p w1 A w2)(*strict*)
   apply(clarsimp)
  apply(rename_tac Ga E N)(*strict*)
  apply(clarsimp)
  apply(rename_tac Ga E N p w1 A w2)(*strict*)
  apply(thin_tac "F_CFG_APLM__fp_valid_input G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}")
  apply(rename_tac G E N p w1 A w2)(*strict*)
  apply(erule_tac
      x="p"
      in ballE)
   apply(rename_tac G E N p w1 A w2)(*strict*)
   prefer 2
   apply(force)
  apply(rename_tac G E N p w1 A w2)(*strict*)
  apply(erule impE)
   apply(rename_tac G E N p w1 A w2)(*strict*)
   apply(rule_tac
      t = "F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N)"
      and s = "F_CFG_APLM__fp G E N"
      in ssubst)
    apply(rename_tac G E N p w1 A w2)(*strict*)
    apply(rule sym)
    apply(rule_tac
      P = "\<lambda>x. x = F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N)"
      and t = "F_CFG_APLM__fp G E N"
      and s = "(if F_CFG_APLM__fp_one G E N = N then N else F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N))"
      in ssubst)
     apply(rename_tac G E N p w1 A w2)(*strict*)
     apply(rule F_CFG_APLM__fp.psimps)
     apply(rule F_CFG_APLM__fp_termination)
     apply(blast)
    apply(rename_tac G E N p w1 A w2)(*strict*)
    apply(clarsimp)
    apply(rule sym)
    apply(rule_tac
      P = "\<lambda>x. x=N"
      and t = "F_CFG_APLM__fp G E N"
      and s = "(if F_CFG_APLM__fp_one G E N = N then N else F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N))"
      in ssubst)
     apply(rename_tac G E N p w1 A w2)(*strict*)
     apply(rule F_CFG_APLM__fp.psimps)
     apply(rule F_CFG_APLM__fp_termination)
     apply(blast)
    apply(rename_tac G E N p w1 A w2)(*strict*)
    apply(clarsimp)
   apply(rename_tac G E N p w1 A w2)(*strict*)
   apply(force)
  apply(rename_tac G E N p w1 A w2)(*strict*)
  apply(erule_tac
      x="w1"
      in allE)
  apply(clarsimp)
  apply(rule_tac
      s = "F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N)"
      and t = "F_CFG_APLM__fp G E N"
      in ssubst)
   apply(rename_tac G E N p w1 A w2)(*strict*)
   apply(rule_tac
      P = "\<lambda>x. x = F_CFG_APLM__fp G E(F_CFG_APLM__fp_one G E N)"
      and t = "F_CFG_APLM__fp G E N"
      and s = "(if F_CFG_APLM__fp_one G E N = N then N else F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N))"
      in ssubst)
    apply(rename_tac G E N p w1 A w2)(*strict*)
    apply(rule F_CFG_APLM__fp.psimps)
    apply(rule F_CFG_APLM__fp_termination)
    apply(blast)
   apply(rename_tac G E N p w1 A w2)(*strict*)
   apply(clarsimp)
   apply(rule sym)
   apply(rule_tac
      P = "\<lambda>x. x=N"
      and t = "F_CFG_APLM__fp G E N"
      and s = "(if F_CFG_APLM__fp_one G E N = N then N else F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N))"
      in ssubst)
    apply(rename_tac G E N p w1 A w2)(*strict*)
    apply(rule F_CFG_APLM__fp.psimps)
    apply(rule F_CFG_APLM__fp_termination)
    apply(blast)
   apply(rename_tac G E N p w1 A w2)(*strict*)
   apply(clarsimp)
  apply(rename_tac G E N p w1 A w2)(*strict*)
  apply(force)
  done

lemma F_CFG_APLM_apply_outside: "
  F_CFG_APLM__fp_valid_input G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}
  \<Longrightarrow> F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G} = F_CFG_APLM__fp_one G (cfgSTD_Nonblockingness_nonterminals G) (F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G})"
  apply(rule F_CFG_APLM__fp_Meta_Lift)
    apply(blast)
   apply(rename_tac Ga E N)(*strict*)
   defer
   apply(thin_tac "F_CFG_APLM__fp_valid_input G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}")
   apply(rename_tac G E N)(*strict*)
   apply(subgoal_tac "F_CFG_APLM__fp G E N=N")
    apply(rename_tac G E N)(*strict*)
    apply(clarsimp)
   apply(rename_tac G E N)(*strict*)
   apply(simp add: F_CFG_APLM__fp_invariants_def F_CFG_APLM__fp_invariant_02_def)
   apply(rule_tac
      s="(if F_CFG_APLM__fp_one G E N = N then N else F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N))"
      and t="F_CFG_APLM__fp G E N"
      in ssubst)
    apply(rename_tac G E N)(*strict*)
    apply(rule F_CFG_APLM__fp.psimps)
    apply(rule F_CFG_APLM__fp_termination)
    apply(blast)
   apply(rename_tac G E N)(*strict*)
   apply(clarsimp)
  apply(rename_tac Ga E N)(*strict*)
  apply(thin_tac "F_CFG_APLM__fp_valid_input G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}")
  apply(rename_tac G E N)(*strict*)
  apply(case_tac "F_CFG_APLM__fp_one G E N = N")
   apply(rename_tac G E N)(*strict*)
   apply(clarsimp)
  apply(rename_tac G E N)(*strict*)
  apply(rule_tac
      t = "F_CFG_APLM__fp G E N"
      and s = "(if F_CFG_APLM__fp_one G E N = N then N else F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N))"
      in ssubst)
   apply(rename_tac G E N)(*strict*)
   apply(rule F_CFG_APLM__fp.psimps)
   apply(rule F_CFG_APLM__fp_termination)
   apply(blast)
  apply(rename_tac G E N)(*strict*)
  apply(clarsimp)
  done

lemma F_CFG_APLMSound0_1: "
  valid_cfg G
  \<Longrightarrow> F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G} = N
  \<Longrightarrow> cfgLM.derivation_initial G d
  \<Longrightarrow> d n = Some (pair e c)
  \<Longrightarrow> cfg_conf c = liftB w1 @ teA x # w2
  \<Longrightarrow> x \<in> N"
  apply(induct n arbitrary: e c w1 x w2 rule: less_induct)
  apply(rename_tac x e c w1 xa w2)(*strict*)
  apply(subgoal_tac "\<exists>m\<le>x. \<exists>w1. cfg_conf(the(get_configuration(d m))) = w1 @ [teA xa] @ w2 \<and> (\<forall>k<m. \<not> (\<exists>w1. cfg_conf(the(get_configuration(d k))) = w1 @ [teA xa] @ w2))")
   apply(rename_tac x e c w1 xa w2)(*strict*)
   prefer 2
   apply(rule earlist_occurence_of_nonterminal)
      apply(rename_tac x e c w1 xa w2)(*strict*)
      apply(force)
     apply(rename_tac x e c w1 xa w2)(*strict*)
     apply(force)
    apply(rename_tac x e c w1 xa w2)(*strict*)
    apply(force)
   apply(rename_tac x e c w1 xa w2)(*strict*)
   apply(simp add: get_configuration_def)
  apply(rename_tac x e c w1 xa w2)(*strict*)
  apply(case_tac x)
   apply(rename_tac x e c w1 xa w2)(*strict*)
   apply(clarsimp)
   apply(rename_tac e c w1 xa w2 w1a)(*strict*)
   apply(simp add: cfgLM.derivation_initial_def cfg_initial_configurations_def)
   apply(clarsimp)
   apply(rename_tac w1 xa w2 w1a)(*strict*)
   apply(case_tac w1)
    apply(rename_tac w1 xa w2 w1a)(*strict*)
    apply(clarsimp)
    apply(rename_tac w1a)(*strict*)
    apply(subgoal_tac "F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G} \<subseteq> cfg_nonterminals G \<and> cfg_initial G \<in> F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}")
     apply(rename_tac w1a)(*strict*)
     prefer 2
     apply(rule F_CFG_APLM_F_CFG_APLM__fp_invariant_02_unfold)
     apply(simp add: F_CFG_APLM__fp_valid_input_def)
     apply(simp add: valid_cfg_def)
    apply(rename_tac w1a)(*strict*)
    apply(force)
   apply(rename_tac w1 xa w2 w1a a list)(*strict*)
   apply(clarsimp)
  apply(rename_tac x e c w1 xa w2 nat)(*strict*)
  apply(rename_tac n)
  apply(rename_tac x e c w1 xa w2 n)(*strict*)
  apply(clarsimp)
  apply(rename_tac e c w1 xa w2 n m w1a)(*strict*)
  apply(case_tac m)
   apply(rename_tac e c w1 xa w2 n m w1a)(*strict*)
   apply(clarsimp)
   apply(rename_tac e c w1 xa w2 n w1a)(*strict*)
   apply(simp add: cfgLM.derivation_initial_def cfg_initial_configurations_def)
   apply(clarsimp)
   apply(simp add: get_configuration_def)
   apply(case_tac "d 0")
    apply(rename_tac e c w1 xa w2 n w1a)(*strict*)
    apply(clarsimp)
   apply(rename_tac e c w1 xa w2 n w1a a)(*strict*)
   apply(clarsimp)
   apply(case_tac a)
   apply(rename_tac e c w1 xa w2 n w1a a option b)(*strict*)
   apply(clarsimp)
   apply(rename_tac e c w1 xa w2 n w1a b)(*strict*)
   apply(case_tac c)
   apply(rename_tac e c w1 xa w2 n w1a b cfg_confa)(*strict*)
   apply(clarsimp)
   apply(rename_tac e w1 xa w2 n w1a b)(*strict*)
   apply(simp add: cfgLM.derivation_initial_def cfg_initial_configurations_def)
   apply(clarsimp)
   apply(rename_tac e w1 xa w2 n w1a)(*strict*)
   apply(case_tac w1a)
    apply(rename_tac e w1 xa w2 n w1a)(*strict*)
    apply(clarsimp)
    apply(rename_tac e w1 n)(*strict*)
    apply(subgoal_tac "F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G} \<subseteq> cfg_nonterminals G \<and> cfg_initial G \<in> F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}")
     apply(rename_tac e w1 n)(*strict*)
     prefer 2
     apply(rule F_CFG_APLM_F_CFG_APLM__fp_invariant_02_unfold)
     apply(simp add: F_CFG_APLM__fp_valid_input_def)
     apply(simp add: valid_cfg_def)
    apply(rename_tac e w1 n)(*strict*)
    apply(force)
   apply(rename_tac e w1 xa w2 n w1a a list)(*strict*)
   apply(clarsimp)
  apply(rename_tac e c w1 xa w2 n m w1a nat)(*strict*)
  apply(rename_tac n)
  apply(rename_tac e c w1 xa w2 na m w1a n)(*strict*)
  apply(case_tac c)
  apply(rename_tac e c w1 xa w2 na m w1a n cfg_confa)(*strict*)
  apply(clarsimp)
  apply(rename_tac e w1 xa w2 na w1a n)(*strict*)
  apply(subgoal_tac "\<exists>e1 e2 c1 c2. d n = Some (pair e1 c1) \<and> d (Suc n) = Some (pair (Some e2) c2) \<and> cfgLM_step_relation G c1 e2 c2")
   apply(rename_tac e w1 xa w2 na w1a n)(*strict*)
   prefer 2
   apply(rule_tac
      m="Suc na"
      in cfgLM.step_detail_before_some_position)
     apply(rename_tac e w1 xa w2 na w1a n)(*strict*)
     apply(rule cfgLM.derivation_initial_is_derivation)
     apply(force)
    apply(rename_tac e w1 xa w2 na w1a n)(*strict*)
    apply(force)
   apply(rename_tac e w1 xa w2 na w1a n)(*strict*)
   apply(force)
  apply(rename_tac e w1 xa w2 na w1a n)(*strict*)
  apply(clarsimp)
  apply(rename_tac e w1 xa w2 na w1a n e1 e2 c1 c2)(*strict*)
  apply(simp add: cfgLM_step_relation_def)
  apply(clarsimp)
  apply(rename_tac e w1 xa w2 na w1a n e1 e2 c1 c2 l r)(*strict*)
  apply(case_tac c2)
  apply(rename_tac e w1 xa w2 na w1a n e1 e2 c1 c2 l r cfg_confa)(*strict*)
  apply(clarsimp)
  apply(rename_tac e w1 xa w2 na w1a n e1 e2 c1 l r)(*strict*)
  apply(case_tac e2)
  apply(rename_tac e w1 xa w2 na w1a n e1 e2 c1 l r prod_lhsa prod_rhsa)(*strict*)
  apply(rename_tac A w)
  apply(rename_tac e w1 xa w2 na w1a n e1 e2 c1 l r A w)(*strict*)
  apply(simp add: get_configuration_def)
  apply(case_tac c1)
  apply(rename_tac e w1 xa w2 na w1a n e1 e2 c1 l r A w cfg_confa)(*strict*)
  apply(clarsimp)
  apply(rename_tac e w1 xa w2 na w1a n e1 l r A w)(*strict*)
  apply(erule_tac
      x="n"
      in allE)
  apply(clarsimp)
  apply(rule_tac
      t="F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}"
      and s="F_CFG_APLM__fp_one G (cfgSTD_Nonblockingness_nonterminals G) (F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G})"
      in ssubst)
   apply(rename_tac e w1 xa w2 na w1a n e1 l r A w)(*strict*)
   apply(rule F_CFG_APLM_apply_outside)
   apply(simp add: F_CFG_APLM__fp_valid_input_def)
   apply(simp add: valid_cfg_def)
  apply(rename_tac e w1 xa w2 na w1a n e1 l r A w)(*strict*)
  apply(simp add: F_CFG_APLM__fp_one_def)
  apply(rule disjI2)
  apply(rule_tac
      x="\<lparr>prod_lhs = A, prod_rhs = w\<rparr>"
      in exI)
  apply(rename_tac e w1 xa w2 na w1a n e1 l r A w)(*strict*)
  apply(clarsimp)
  apply(erule_tac
      x="n"
      in meta_allE)
  apply(clarsimp)
  apply(erule_tac
      x="e1"
      in meta_allE)
  apply(clarsimp)
  apply(erule_tac
      x="\<lparr>cfg_conf = l @ teA A # r\<rparr>"
      in meta_allE)
  apply(clarsimp)
  apply(erule_tac
      x="filterB l"
      in meta_allE)
  apply(erule_tac
      x="A"
      in meta_allE)
  apply(erule_tac
      x="r"
      in meta_allE)
  apply(clarsimp)
  apply(erule meta_impE)
   apply(rename_tac e w1 xa w2 na w1a n e1 l r A w)(*strict*)
   apply (metis liftBDeConv2)
  apply(rename_tac e w1 xa w2 na w1a n e1 l r A w)(*strict*)
  apply(rule conjI)
   apply(rename_tac e w1 xa w2 na w1a n e1 l r A w)(*strict*)
   apply(force)
  apply(rename_tac e w1 xa w2 na w1a n e1 l r A w)(*strict*)
  apply(subgoal_tac "prefix (l@w) w1a \<or> prefix w1a (l@w)")
   apply(rename_tac e w1 xa w2 na w1a n e1 l r A w)(*strict*)
   prefer 2
   apply(rule mutual_prefix_prefix)
   apply(force)
  apply(rename_tac e w1 xa w2 na w1a n e1 l r A w)(*strict*)
  apply(case_tac "prefix (l@w) w1a")
   apply(rename_tac e w1 xa w2 na w1a n e1 l r A w)(*strict*)
   apply(clarsimp)
   apply(simp add: prefix_def)
   apply(force)
  apply(rename_tac e w1 xa w2 na w1a n e1 l r A w)(*strict*)
  apply(clarsimp)
  apply(simp add: prefix_def)
  apply(clarsimp)
  apply(rename_tac e w1 xa w2 na w1a n e1 l r A w c)(*strict*)
  apply(case_tac c)
   apply(rename_tac e w1 xa w2 na w1a n e1 l r A w c)(*strict*)
   apply(force)
  apply(rename_tac e w1 xa w2 na w1a n e1 l r A w c a list)(*strict*)
  apply(clarsimp)
  apply(rename_tac e w1 xa w2 na w1a n e1 l r A w a list)(*strict*)
  apply(thin_tac "\<forall>c. l @ w @ c \<noteq> w1a")
  apply(subgoal_tac "prefix w1a l \<or> prefix l w1a")
   apply(rename_tac e w1 xa w2 na w1a n e1 l r A w a list)(*strict*)
   prefer 2
   apply(rule mutual_prefix_prefix)
   apply(force)
  apply(rename_tac e w1 xa w2 na w1a n e1 l r A w a list)(*strict*)
  apply(case_tac "prefix w1a l")
   apply(rename_tac e w1 xa w2 na w1a n e1 l r A w a list)(*strict*)
   apply(clarsimp)
   apply(simp add: prefix_def)
   apply(clarsimp)
   apply(rename_tac e w1 xa w2 na w1a n e1 r A w a list c)(*strict*)
   apply(case_tac c)
    apply(rename_tac e w1 xa w2 na w1a n e1 r A w a list c)(*strict*)
    apply(clarsimp)
    apply(rename_tac e w1 xa na w1a n e1 r A list)(*strict*)
    apply(rule_tac
      x="[]"
      in exI)
    apply(clarsimp)
   apply(rename_tac e w1 xa w2 na w1a n e1 r A w a list c aa lista)(*strict*)
   apply(clarsimp)
   apply(rename_tac e w1 xa na w1a n e1 r A w lista)(*strict*)
   apply (metis elemInsetA emptyE)
  apply(rename_tac e w1 xa w2 na w1a n e1 l r A w a list)(*strict*)
  apply(clarsimp)
  apply(simp add: prefix_def)
  apply(clarsimp)
  apply(rename_tac e w1 xa na n e1 l r A list c)(*strict*)
  apply(rule_tac
      x="c"
      in exI)
  apply(clarsimp)
  apply(rename_tac e w1 xa na n e1 l r A list c x)(*strict*)
  apply(thin_tac "\<forall>w1. l @ [teA A] \<noteq> w1 @ teA xa # list")
  apply(thin_tac "d n = Some (pair e1 \<lparr>cfg_conf = l @ teA A # r\<rparr>)")
  apply(subgoal_tac "\<exists>x. n+x=na")
   apply(rename_tac e w1 xa na n e1 l r A list c x)(*strict*)
   prefer 2
   apply(rule_tac
      x="na-n"
      in exI)
   apply(force)
  apply(rename_tac e w1 xa na n e1 l r A list c x)(*strict*)
  apply(clarsimp)
  apply(rename_tac e w1 xa n l r A list c x xb)(*strict*)
  apply(rule_tac
      A="setA (l@c)"
      in set_mp)
   apply(rename_tac e w1 xa n l r A list c x xb)(*strict*)
   apply(rule_tac
      e="(Some \<lparr>prod_lhs = A, prod_rhs = c @ teA xa # list\<rparr>)"
      and n="Suc n"
      and m="xb"
      in nonterminals_are_eliminable_in_untouchable_context)
      apply(rename_tac e w1 xa n l r A list c x xb)(*strict*)
      apply(force)
     apply(rename_tac e w1 xa n l r A list c x xb)(*strict*)
     apply(force)
    apply(rename_tac e w1 xa n l r A list c x xb)(*strict*)
    apply(force)
   apply(rename_tac e w1 xa n l r A list c x xb)(*strict*)
   apply(force)
  apply(rename_tac e w1 xa n l r A list c x xb)(*strict*)
  apply(simp add: setAConcat)
  done

lemma F_CFG_APLMSoundL1: "
  valid_cfg G
  \<Longrightarrow> cfgLM_accessible_nonterminals G \<subseteq> F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}"
  apply(simp add: cfgLM_accessible_nonterminals_def get_configuration_def)
  apply(auto)
  apply(rename_tac x d n c w1 w2)(*strict*)
  apply(case_tac "d n")
   apply(rename_tac x d n c w1 w2)(*strict*)
   apply(force)
  apply(rename_tac x d n c w1 w2 a)(*strict*)
  apply(case_tac a)
  apply(rename_tac x d n c w1 w2 a option b)(*strict*)
  apply(clarsimp)
  apply(rename_tac x d n c w1 w2 option)(*strict*)
  apply(rule F_CFG_APLMSound0_1)
      apply(rename_tac x d n c w1 w2 option)(*strict*)
      apply(force)
     apply(rename_tac x d n c w1 w2 option)(*strict*)
     apply(force)
    apply(rename_tac x d n c w1 w2 option)(*strict*)
    apply(force)
   apply(rename_tac x d n c w1 w2 option)(*strict*)
   apply(force)
  apply(rename_tac x d n c w1 w2 option)(*strict*)
  apply(force)
  done

lemma F_CFG_APLM_F_CFG_APLM__fp_invariant_03_unfold: "
  F_CFG_APLM__fp_valid_input G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}
  \<Longrightarrow> F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G} \<subseteq> cfgLM_accessible_nonterminals G"
  apply(rule F_CFG_APLM__fp_Meta_Lift)
    apply(blast)
   apply(rename_tac Ga E N)(*strict*)
   defer
   apply(thin_tac "F_CFG_APLM__fp_valid_input G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}")
   apply(rename_tac G E N)(*strict*)
   apply(rename_tac G E N)
   apply(clarsimp)
   apply(rename_tac G E N x)(*strict*)
   apply(subgoal_tac "F_CFG_APLM__fp G E N=N")
    apply(rename_tac G E N x)(*strict*)
    apply(clarsimp)
    apply(simp add: F_CFG_APLM__fp_invariants_def F_CFG_APLM__fp_invariant_03_def)
    apply(rule_tac
      A="F_CFG_APLM__fp G E N"
      in set_mp)
     apply(rename_tac G E N x)(*strict*)
     apply(force)
    apply(rename_tac G E N x)(*strict*)
    apply(clarsimp)
   apply(rename_tac G E N x)(*strict*)
   apply(rule_tac
      s="(if F_CFG_APLM__fp_one G E N = N then N else F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N))"
      and t="F_CFG_APLM__fp G E N"
      in ssubst)
    apply(rename_tac G E N x)(*strict*)
    apply(rule F_CFG_APLM__fp.psimps)
    apply(rule F_CFG_APLM__fp_termination)
    apply(blast)
   apply(rename_tac G E N x)(*strict*)
   apply(clarsimp)
  apply(rename_tac Ga E N)(*strict*)
  apply(thin_tac "F_CFG_APLM__fp_valid_input G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}")
  apply(rename_tac G E N)(*strict*)
  apply(clarsimp)
  apply(rename_tac G E N x)(*strict*)
  apply(case_tac "N = F_CFG_APLM__fp_one G E N")
   apply(rename_tac G E N x)(*strict*)
   apply(clarsimp)
   apply(force)
  apply(rename_tac G E N x)(*strict*)
  apply(rule_tac
      A = "F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N)"
      in set_mp)
   apply(rename_tac G E N x)(*strict*)
   apply(blast)
  apply(rename_tac G E N x)(*strict*)
  apply(rule_tac
      t = "F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N)"
      and s = "F_CFG_APLM__fp G E N"
      in ssubst)
   apply(rename_tac G E N x)(*strict*)
   apply(rule sym)
   apply(rule_tac
      P = "\<lambda>x. x = F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N)"
      and t = "F_CFG_APLM__fp G E N"
      and s = "(if F_CFG_APLM__fp_one G E N = N then N else F_CFG_APLM__fp G E (F_CFG_APLM__fp_one G E N))"
      in ssubst)
    apply(rename_tac G E N x)(*strict*)
    apply(rule F_CFG_APLM__fp.psimps)
    apply(rule F_CFG_APLM__fp_termination)
    apply(blast)
   apply(rename_tac G E N x)(*strict*)
   apply(clarsimp)
  apply(rename_tac G E N x)(*strict*)
  apply(clarsimp)
  done

lemma F_CFG_APLMSoundL2: "
  valid_cfg G
  \<Longrightarrow> cfgLM_accessible_nonterminals G \<supseteq> F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}"
  apply(rule F_CFG_APLM_F_CFG_APLM__fp_invariant_03_unfold)
  apply(simp add: F_CFG_APLM__fp_valid_input_def valid_cfg_def)
  done

lemma F_CFG_APLMSoundL: "
  valid_cfg G
  \<Longrightarrow> cfgLM_accessible_nonterminals G = F_CFG_APLM__fp G (cfgSTD_Nonblockingness_nonterminals G) {cfg_initial G}"
  apply(rule order_antisym)
   apply(rule F_CFG_APLMSoundL1)
   apply(blast)
  apply(rule F_CFG_APLMSoundL2)
  apply(blast)
  done

theorem F_CFG_APLM_vs_cfgLM_SPEC_CFGEA__Productions: "
  valid_cfg G
  \<Longrightarrow> F_CFG_APLM G = cfgLM_SPEC_CFGEA__Productions G"
  apply(subgoal_tac "cfgLM_accessible_nonterminals G = F_CFG_APLM__fp G (F_CFG_EB__fp G {}) {cfg_initial G}")
   apply(simp add: F_CFG_APLM_def cfgLM_SPEC_CFGEA__Productions_def Let_def)
  apply(rule_tac t="F_CFG_EB__fp G {}" in ssubst)
   prefer 2
   apply(rule F_CFG_APLMSoundL)
   apply(force)
  apply (metis F_CFG_EBSoundL)
  done

end


theory SINVAR_CommunicationPartners
imports "../TopoS_Helper"
begin

subsection \<open>SecurityInvariant CommunicationPartners\<close>

text\<open>
Idea of this securityinvariant:
  Only some nodes can communicate with Master nodes.
    It constrains who may access master nodes, Master nodes can access the world (except other prohibited master nodes).
  A node configured as Master has a list of nodes that can access it.
  Also, in order to be able to access a Master node, the sender must be denoted as a node we Care about.
  By default, all nodes are set to DontCare, thus they cannot access Master nodes. But they can access
  all other DontCare nodes and Care nodes.

  TL;DR: An access control list determines who can access a master node.
\<close>
datatype 'v node_config = DontCare | Care | Master "'v list"

definition default_node_properties :: "'v node_config"
  where  "default_node_properties = DontCare"

text\<open>Unrestricted accesses among DontCare nodes!\<close>

fun allowed_flow :: "'v node_config \<Rightarrow> 'v \<Rightarrow> 'v node_config \<Rightarrow> 'v \<Rightarrow> bool" where
  "allowed_flow DontCare _ DontCare _ = True" |
  "allowed_flow DontCare _ Care _ = True" |
  "allowed_flow DontCare _ (Master _) _ = False" |
  "allowed_flow Care _ Care _ = True" |
  "allowed_flow Care _ DontCare _ = True" |
  "allowed_flow Care s (Master M) r = (s \<in> set M)" |
  "allowed_flow (Master _) s (Master M) r = (s \<in> set M)" |
  "allowed_flow (Master _) _ Care _ = True" |
  "allowed_flow (Master _) _ DontCare _ = True"

fun sinvar :: "'v graph \<Rightarrow> ('v \<Rightarrow> 'v node_config) \<Rightarrow> bool" where
  "sinvar G nP = (\<forall> (s,r) \<in> edges G. s \<noteq> r \<longrightarrow> allowed_flow (nP s) s (nP r) r)"

definition receiver_violation :: "bool" where "receiver_violation = False"

subsubsection \<open>Preliminaries\<close>

subsubsection \<open>ENRnr\<close>
  lemma CommunicationPartners_ENRnrSR: "SecurityInvariant_withOffendingFlows.sinvar_all_edges_normal_form_not_refl_SR sinvar allowed_flow"
    by(simp add: SecurityInvariant_withOffendingFlows.sinvar_all_edges_normal_form_not_refl_SR_def)
  lemma Unassigned_weakrefl: "\<forall> s r. allowed_flow DontCare s DontCare r"
    by(simp)
  lemma Unassigned_botdefault: "\<forall> s r. (nP r) \<noteq> DontCare \<longrightarrow> \<not> allowed_flow (nP s) s (nP r) r \<longrightarrow> \<not> allowed_flow DontCare s (nP r) r"
    apply(rule allI)+
    apply(case_tac "nP r")
      apply(simp_all)
    apply(case_tac "nP s")
      apply(simp_all)
    done
  lemma  "\<not> allowed_flow DontCare s (Master M) r" by(simp)
  lemma  "\<not> allowed_flow any s (Master []) r" by(cases any, simp_all)

  lemma All_to_Unassigned: "\<forall> s r. allowed_flow (nP s) s DontCare r"
    by (rule allI, rule allI, case_tac "nP s", simp_all)
  lemma Unassigned_default_candidate: "\<forall> s r. \<not> allowed_flow (nP s) s (nP r) r \<longrightarrow> \<not> allowed_flow DontCare s (nP r) r"
    apply(intro allI, rename_tac s r)+
    apply(case_tac "nP s")
      apply(simp_all)
     apply(case_tac "nP r")
       apply(simp_all)
    apply(case_tac "nP r")
      apply(simp_all)
    done

  definition CommunicationPartners_offending_set:: "'v graph \<Rightarrow> ('v \<Rightarrow> 'v node_config) \<Rightarrow> ('v \<times> 'v) set set" where
  "CommunicationPartners_offending_set G nP = (if sinvar G nP then
      {}
     else
      { {e \<in> edges G. case e of (e1,e2) \<Rightarrow> e1 \<noteq> e2 \<and> \<not> allowed_flow (nP e1) e1 (nP e2) e2} })"
  lemma CommunicationPartners_offending_set:
  "SecurityInvariant_withOffendingFlows.set_offending_flows sinvar = CommunicationPartners_offending_set"
    apply(simp only: fun_eq_iff ENFnrSR_offending_set[OF CommunicationPartners_ENRnrSR] CommunicationPartners_offending_set_def)
    apply(rule allI)+
    apply(rename_tac G nP)
    apply(auto)
  done

interpretation CommunicationPartners: SecurityInvariant_ACS
where default_node_properties = default_node_properties
and sinvar = sinvar
rewrites "SecurityInvariant_withOffendingFlows.set_offending_flows sinvar = CommunicationPartners_offending_set"
  unfolding receiver_violation_def
  unfolding default_node_properties_def
  apply unfold_locales
    apply(rule ballI)
    apply (rule_tac f="f" in SecurityInvariant_withOffendingFlows.ENFnrSR_fsts_weakrefl_instance[OF CommunicationPartners_ENRnrSR Unassigned_weakrefl Unassigned_botdefault All_to_Unassigned])
     apply(simp)
    apply(simp)
  apply(erule default_uniqueness_by_counterexample_ACS)
  apply(rule_tac x="\<lparr> nodes={vertex_1,vertex_2}, edges = {(vertex_1,vertex_2)} \<rparr>" in exI, simp)
  apply(rule conjI)
   apply(simp add: wf_graph_def)
  apply(simp add: CommunicationPartners_offending_set CommunicationPartners_offending_set_def delete_edges_simp2)
  apply(case_tac otherbot, simp_all)
   apply(rule_tac x="(\<lambda> x. DontCare)(vertex_1 := DontCare, vertex_2 := Master [vertex_1])" in exI, simp)
   apply(rule_tac x="vertex_1" in exI, simp)
   apply(simp split: prod.split)
   apply(clarify)
   apply force
  apply(rename_tac M) (*case Master M*)
  apply(rule_tac x="(\<lambda> x. DontCare)(vertex_1 := DontCare, vertex_2 := (Master (vertex_1#M')))" in exI, simp)
  apply(simp split: prod.split)
  apply(clarify)
  apply force
 apply(fact CommunicationPartners_offending_set)
done

  lemma TopoS_SubnetsInGW: "SecurityInvariant sinvar default_node_properties receiver_violation"
  unfolding receiver_violation_def by unfold_locales

text\<open>Example:\<close>
lemma "sinvar \<lparr>nodes = {''db1'', ''db2'', ''h1'', ''h2'', ''foo'', ''bar''},
               edges = {(''h1'', ''db1''), (''h2'', ''db1''), (''h1'', ''h2''),
                        (''db1'', ''h1''), (''db1'', ''foo''), (''db1'', ''db2''), (''db1'', ''db1''),
                        (''h1'', ''foo''), (''foo'', ''h1''), (''foo'', ''bar'')}\<rparr>
    (((((\<lambda>h. default_node_properties)(''h1'' := Care))(''h2'' := Care))
        (''db1'' := Master [''h1'', ''h2'']))(''db2'' := Master [''db1'']))" by eval

hide_fact (open) sinvar_mono
hide_const (open) sinvar receiver_violation default_node_properties

end


theory Examples_Poincare_Map
imports
  "HOL-ODE-Numerics.ODE_Numerics"
begin

subsection \<open>Van der Pol oscillator\<close>
experiment begin

schematic_goal vdp_fas:
  "[X!1, X!1 * (1 - (X!0)\<^sup>2) - X!0] = interpret_floatariths ?fas X"
  unfolding power2_eq_square\<comment> \<open>TODO: proper affine implementation of power\<close>
  by (reify_floatariths)

concrete_definition vdp_fas uses vdp_fas

interpretation vdp: ode_interpretation true_form UNIV vdp_fas "\<lambda>(x, y). (y, y * (1 - x\<^sup>2) - x)::real*real"
  "n::2" for n
  by standard
    (auto simp: vdp_fas_def less_Suc_eq_0_disj nth_Basis_list_prod Basis_list_real_def
      mk_ode_ops_def eucl_of_list_prod power2_eq_square inverse_eq_divide intro!: isFDERIV_I)

lemma poincare_section_rep[poincare_tac_theorems]:
  "{(1, FloatR 9 (-2))..(2::real, FloatR 9 (-2))} = {eucl_of_list [1, FloatR 9 (-2)]..eucl_of_list [2, FloatR 9 (-2)]}"
  by (auto simp: eucl_of_list_prod)

lemma poincare_section_le[poincare_tac_theorems]:
  "{(x::real, y::real). y \<le> FloatR 9 (- 2)} =
    {x. if True then x \<bullet> Basis_list ! 1 \<le> [1, FloatR 9 (- 2)] ! 1
        else [1, FloatR 9 (- 2)] ! 1 \<le> x \<bullet> Basis_list ! 1}"
  by (auto simp: Basis_list_prod_def Basis_list_real_def)

abbreviation "vdp_ro \<equiv> ro 2 10 7 2 2 2"

lemma vdp_ro: "TAG_reach_optns vdp_ro" by simp

lemma vdp_start: "TAG_sctn True" by simp

lemma ninequarters: "2.25 = FloatR 9 (-2)"
  by auto

subsection \<open>No intermediate Poincare map\<close>

lemma vdp_pi_0: "vdp.guards_invar DIM(real \<times> real) []"
  by (auto simp: vdp.guards_invar_def)

lemma vanderpol_derivative_bounds:
  notes [poincare_tac_theorems] = vdp_pi_0 vdp_ro vdp_start
  defines "\<Sigma> \<equiv> {(1::real, 2.25::real) .. (2, 2.25)}"
  shows "\<forall>x\<in>{(1.41, 2.25) .. (1.42, 2.25)}.
  vdp.returns_to \<Sigma> x \<and>
  vdp.return_time \<Sigma> differentiable at x within {(x, y). y \<le> 2.25} \<and>
  (\<exists>D. (vdp.poincare_map \<Sigma> has_derivative blinfun_apply D) (at x within {(x, y). y \<le> 2.25}) \<and>
        vdp.poincare_map \<Sigma> x \<in> {(1.41, 2.25) .. (1.42, 2.25)} \<and>
        D o\<^sub>L blinfun_of_list [1, 0,
                             0, 1] \<in> vdp.blinfuns_of_lvivl ([-0.016, -0.024, 0, 0], [0.021, 0.031, 0, 0]))
  "
  unfolding ninequarters \<Sigma>_def
  by (tactic \<open>poincare'_bnds_tac @{thms vdp_fas_def} 30 50 20 14 [(0, 1, "0x000000")] "" (* "out_p0_vdp_0.out" *)  @{context} 1\<close>)

lemma blinfun_of_list_id2: "blinfun_of_list [1, 0, 0, 1] = (id_blinfun::(real*real)\<Rightarrow>\<^sub>L(real*real))"
  apply (auto intro!: blinfun_euclidean_eqI simp: Basis_prod_def)
  apply (auto simp: blinfun_of_list_def blinfun_of_matrix_apply)
   apply (auto simp: Basis_prod_def Basis_list_real_def)
  done

lemma norm_blinfun_of_list:
  "norm (blinfun_of_list xs::'a::executable_euclidean_space\<Rightarrow>\<^sub>L'a) \<le> (\<Sum>x\<leftarrow>xs. abs x)"
  if "length xs = DIM('a)*DIM('a)"\<comment> \<open>should work for all lists\<close>
  unfolding blinfun_of_list_def
  apply (rule norm_blinfun_of_matrix[le])
  apply (auto simp: sum_Basis_sum_nth_Basis_list)
  apply (subst add.commute)
  apply (subst sum_mult_product[symmetric])
  by (auto simp: sum_list_sum_nth that atLeast0LessThan)

lemma norm_blinfuns_of_ivl2:
  "norm x \<le> (\<Sum>i<DIM('a)*DIM('a). max (abs (xs!i)) (abs (ys!i)))"
  if "x \<in> vdp.blinfuns_of_lvivl (xs, ys)" "length xs = DIM('a)*DIM('a)" "length ys = DIM('a)*DIM('a)"
  for x::"'a::executable_euclidean_space\<Rightarrow>\<^sub>L'a"
proof -
  from that
  obtain es where xs: "x = blinfun_of_list es"
    "es \<in> list_interval xs ys"
    by (auto simp: vdp.blinfuns_of_lvivl_def)
  have [simp]: "length es = DIM('a)*DIM('a)"
    using xs that
    by (auto simp: list_interval_def dest!: list_all2_lengthD )
  note xs(1)
  also have "norm (blinfun_of_list es::'a\<Rightarrow>\<^sub>L'a) \<le> (\<Sum>x\<leftarrow>es. abs x)"
    by (rule norm_blinfun_of_list) simp
  also have "\<dots> \<le> (\<Sum>i<DIM('a)*DIM('a). max (abs (xs!i)) (abs (ys!i)))"
    using xs(2)
    by (auto simp: sum_list_sum_nth atLeast0LessThan list_interval_def
        list_all2_conv_all_nth max_def that dest!: spec
        intro!: sum_mono)
  finally show ?thesis .
qed

lemma unique_Poincare:
  defines "\<Sigma> \<equiv> {(1::real, 2.25::real) .. (2, 2.25)}"
  shows "\<exists>!x. x \<in> {(1.41::real, 2.25::real) .. (1.42, 2.25)} \<and> vdp.poincare_map \<Sigma> x = x"
proof -
  let ?S = "{(x, y). y \<le> 225 / 10\<^sup>2}"
  define S where "S \<equiv> {(1.41::real, 2.25::real) .. (1.42, 2.25)}"
  have "convex S" "complete S" "S \<noteq> {}"  "S \<subseteq> ?S"
    unfolding S_def
    by (auto intro!: compact_imp_complete)
  then show ?thesis
    unfolding S_def[symmetric]
  proof (rule vdp.Poincare_Banach_fixed_pointI)
    show "\<forall>x\<in>S. vdp.poincare_map \<Sigma> x \<in> S \<and>
           (\<exists>D. (vdp.poincare_map \<Sigma> has_derivative D) (at x within {(x, y). y \<le> 225 / 10\<^sup>2}) \<and>
                onorm D \<le> 0.06)"
    proof
      fix x
      assume "x \<in> S"
      from vanderpol_derivative_bounds[folded S_def \<Sigma>_def, rule_format, OF this]
      obtain D where D: "vdp.returns_to \<Sigma> x"
        "vdp.poincare_map \<Sigma> x \<in> S"
        "vdp.return_time \<Sigma> differentiable at x within ?S"
        "(vdp.poincare_map \<Sigma> has_derivative blinfun_apply D) (at x within ?S)"
        "D \<in> vdp.blinfuns_of_lvivl ([-0.016, -0.024, 0, 0], [0.021, 0.031, 0, 0])"
        by (auto simp: blinfun_of_list_id2)
      have "onorm D = norm D" by transfer simp
      also from norm_blinfuns_of_ivl2[OF D(5)]
      have "norm D \<le> 0.06" by (simp add: max_def)
      finally show "vdp.poincare_map \<Sigma> x \<in> S \<and>
        (\<exists>D. (vdp.poincare_map \<Sigma> has_derivative D) (at x within ?S) \<and> onorm D \<le> 0.06)"
        using D by auto
    qed
  qed simp
qed

lemma
  notes [poincare_tac_theorems] = vdp_pi_0 vdp_ro vdp_start
  shows "\<forall>x\<in>{(1.41, 2.25) .. (1.42, 2.25)}.
  vdp.returns_to   {(1, 2.25) .. (2, 2.25)} x \<and>
  vdp.poincare_map {(1, 2.25) .. (2, 2.25)} x \<in> {(1.41, 2.25) .. (1.42, 2.25)}"
  unfolding ninequarters
  by (tactic \<open>poincare_bnds_tac @{thms vdp_fas_def} 30 20 7 14 [(0, 1, "0x000000")] "" (* "out_p0_vdp_0.out" *)  @{context} 1\<close>)

lemma
  notes [poincare_tac_theorems] = vdp_pi_0 vdp_ro vdp_start
  shows "\<forall>x\<in>{(1.35, 2.25) .. (1.45, 2.25)}.
  vdp.returns_to   {(1, 2.25) .. (2, 2.25)} x \<and>
  vdp.poincare_map {(1, 2.25) .. (2, 2.25)} x \<in> {(1.35, 2.25) .. (1.45, 2.25)}"
  unfolding ninequarters
  by (tactic \<open>poincare_bnds_tac @{thms vdp_fas_def} 30 20 7 14 [(0, 1, "0x000000")] "" (* "out_p0_vdp_1.out" *)  @{context} 1\<close>)

subsection \<open>One intermediate Poincare map\<close>

lemma vdp_pi_1: "vdp.guards_invar DIM(real \<times> real) [([xsec2' 1 (-2, 0)], vdp_ro)]"
  by (auto simp: vdp.guards_invar_def)

lemma
  notes [poincare_tac_theorems] = vdp_ro vdp_start vdp_pi_1
  shows "\<forall>x\<in>{(1.41, 2.25) .. (1.42, 2.25)}.
  vdp.returns_to   {(1, 2.25) .. (2, 2.25)} x \<and>
  vdp.poincare_map {(1, 2.25) .. (2, 2.25)} x \<in> {(1.41, 2.25) .. (1.42, 2.25)}"
  unfolding ninequarters
  by (tactic \<open>poincare_bnds_tac @{thms vdp_fas_def} 30 20 7 14 [(0, 1, "0x000000")] "" (* "out_p1_vdp_0.out" *)  @{context} 1\<close>)

lemma
  notes [poincare_tac_theorems] = vdp_ro vdp_start vdp_pi_1
  shows "\<forall>x\<in>{(1.35, 2.25) .. (1.45, 2.25)}.
  vdp.returns_to   {(1, 2.25) .. (2, 2.25)} x \<and>
  vdp.poincare_map {(1, 2.25) .. (2, 2.25)} x \<in> {(1.35, 2.25) .. (1.45, 2.25)}"
  unfolding ninequarters
  by (tactic \<open>poincare_bnds_tac @{thms vdp_fas_def} 30 20 7 12 [(0, 1, "0x000000")] "" (* "out_p1_vdp_1.out" *) @{context} 1\<close>)

lemma
  notes [poincare_tac_theorems] = vdp_ro vdp_start vdp_pi_1
  shows "\<forall>x\<in>{(1.3, 2.25) .. (1.5, 2.25)}.
  vdp.returns_to   {(1, 2.25) .. (2, 2.25)} x \<and>
  vdp.poincare_map {(1, 2.25) .. (2, 2.25)} x \<in> {(1.3, 2.25) .. (1.5, 2.25)}"
  unfolding ninequarters
  by (tactic \<open>poincare_bnds_tac @{thms vdp_fas_def} 30 20 7 12 [(0, 1, "0x000000")] "" (* "out_p1_vdp_2.out" *) @{context} 1\<close>)

lemma
  notes [poincare_tac_theorems] = vdp_ro vdp_start vdp_pi_1
  shows "\<forall>x\<in>{(1.15, 2.25) .. (1.65, 2.25)}.
  vdp.returns_to   {(1, 2.25) .. (2, 2.25)} x \<and>
  vdp.poincare_map {(1, 2.25) .. (2, 2.25)} x \<in> {(1.15, 2.25) .. (1.65, 2.25)}"
  unfolding ninequarters
  by (tactic \<open>poincare_bnds_tac @{thms vdp_fas_def} 30 30 7 16 [(0, 1, "0x000000")] "" (* "out_p1_vdp_3.out" *) @{context} 1\<close>)

end

subsection \<open>Example Approximate JNF-Lorenz\<close>
experiment begin

schematic_goal
  lorenz_fas:
  "[11.8 * X!0 - 0.29 * (X!0 + X!1) * X!2,
    -22.8 * X!1 + 0.29*(X!0 + X!1) * X!2,
    -2.67*X!2 + (X!0 + X!1)*(2.2*X!0 - 1.3*X!1)] =
  interpret_floatariths ?fas X"
  by (reify_floatariths)
concrete_definition lorenz_fas uses lorenz_fas

interpretation lorenz: ode_interpretation true_form UNIV lorenz_fas
  "\<lambda>(x1, x2, x3).
    (11.8 * x1 - 0.29 * (x1 + x2) * x3,
    -22.8 * x2 + 0.29*(x1 + x2) * x3,
    -2.67*x3 + (x1 + x2)*(2.2*x1 - 1.3*x2))
    ::real*real*real"
  "three::3"
  by standard
    (auto simp: lorenz_fas_def less_Suc_eq_0_disj nth_Basis_list_prod Basis_list_real_def isDERIV_Power_iff
      mk_ode_ops_def eucl_of_list_prod power2_eq_square inverse_eq_divide intro!: isFDERIV_I)

abbreviation "lorenz_ro \<equiv> ro 2 10 7 2 2 2"

lemma lorenz_ro: "TAG_reach_optns lorenz_ro" by simp

lemma lorenz_start: "TAG_sctn True" by simp

subsection \<open>No intermediate Poincare map\<close>

lemma lorenz_pi_0: "lorenz.guards_invar DIM(real \<times> real \<times> real) []"
  by (auto simp: lorenz.guards_invar_def)

abbreviation \<Sigma>::"(real * real * real) set"
  where "\<Sigma> \<equiv> {(-6, -6, 27) .. (6, 6, 27)}"

lemma poincare_section_rep[poincare_tac_theorems]:
  "\<Sigma> = {eucl_of_list [-6, -6, 27]..eucl_of_list [6, 6, 27]}"
  by (auto simp: eucl_of_list_prod)

abbreviation "lorenz_iv x y w \<equiv> {(x - w, y - w, 27)..(x + w, y + w, 27)::real*real*real}"

subsection \<open>With intermediate Poincare map\<close>

lemma lorenz_pi_1: "lorenz.guards_invar DIM(real \<times> real \<times> real) [([xsec 2 (-1, 1) (0, 10)], lorenz_ro)]"
  by (auto simp: lorenz.guards_invar_def)

lemma
  notes [poincare_tac_theorems] = lorenz_pi_1 lorenz_ro lorenz_start
  shows "\<forall>x\<in>lorenz_iv 0.84 2.21 0.005.
  lorenz.returns_to   \<Sigma> x \<and>
  lorenz.poincare_map \<Sigma> x \<in> lorenz_iv (-2.17) 0.98 0.3"
  by (tactic \<open>poincare_bnds_tac @{thms lorenz_fas_def} 30 30 9 14 [(0, 2, "0x000000"), (1, 2, "0xff0000")] "" (* "out_p1_lorenz_0.out" *) @{context} 1\<close>)

lemma
  notes [poincare_tac_theorems] = lorenz_pi_1 lorenz_ro lorenz_start
  shows "\<forall>x\<in>lorenz_iv 0.86 2.21 0.005.
  lorenz.returns_to   \<Sigma> x \<and>
  lorenz.poincare_map \<Sigma> x \<in> lorenz_iv (-1.8) 1.2 0.2"
  by (tactic \<open>poincare_bnds_tac @{thms lorenz_fas_def} 30 30 9 14 [(0, 2, "0x000000"), (1, 2, "0xff0000")] "" (* "out_p1_lorenz_1.out" *) @{context} 1\<close>)

lemma
  notes [poincare_tac_theorems] = lorenz_pi_1 lorenz_ro lorenz_start
  shows "\<forall>x\<in>lorenz_iv 0.88 2.21 0.005.
  lorenz.returns_to   \<Sigma> x \<and>
  lorenz.poincare_map \<Sigma> x \<in> lorenz_iv (-1.58) 1.3 0.1"
  by (tactic \<open>poincare_bnds_tac @{thms lorenz_fas_def} 30 30 9 14 [(0, 2, "0x000000"), (1, 2, "0xff0000")] "" (* "out_p1_lorenz_2.out" *) @{context} 1\<close>)

lemma
  notes [poincare_tac_theorems] = lorenz_pi_1 lorenz_ro lorenz_start
  shows "\<forall>x\<in>lorenz_iv 0.90 2.21 0.005.
  lorenz.returns_to   \<Sigma> x \<and>
  lorenz.poincare_map \<Sigma> x \<in> lorenz_iv (-1.4) 1.4 0.1"
  by (tactic \<open>poincare_bnds_tac @{thms lorenz_fas_def} 30 30 9 14 [(0, 2, "0x000000"), (1, 2, "0xff0000")] "" (* "out_p1_lorenz_3.out" *) @{context} 1\<close>)

lemma
  notes [poincare_tac_theorems] = lorenz_pi_1 lorenz_ro lorenz_start
  shows "\<forall>x\<in>lorenz_iv 0.92 2.21 0.005.
  lorenz.returns_to   \<Sigma> x \<and>
  lorenz.poincare_map \<Sigma> x \<in> lorenz_iv (-1.24) 1.45 0.1"
  by (tactic \<open>poincare_bnds_tac @{thms lorenz_fas_def} 30 30 9 14 [(0, 2, "0x000000"), (1, 2, "0xff0000")] "" (* "out_p1_lorenz_4.out" *) @{context} 1\<close>)

lemma
  notes [poincare_tac_theorems] = lorenz_pi_1 lorenz_ro lorenz_start
  shows "\<forall>x\<in>lorenz_iv 0.94 2.21 0.005.
  lorenz.returns_to   \<Sigma> x \<and>
  lorenz.poincare_map \<Sigma> x \<in> lorenz_iv (-1.11) 1.5 0.1"
  by (tactic \<open>poincare_bnds_tac @{thms lorenz_fas_def} 30 30 9 14 [(0, 2, "0x000000"), (1, 2, "0xff0000")] "" (* "out_p1_lorenz_5.out" *) @{context} 1\<close>)

end

subsection \<open>Controller 2D\<close>

text \<open>An example from @{cite "barriertubes"}\<close>

experiment begin

schematic_goal c2d:
  "[X!0 * X!1 + (X!1)^3 + 2, (X!0)\<^sup>2 + 2 * (X!0) - 3 * X!1] = interpret_floatariths ?fas X"
  unfolding power2_eq_square power3_eq_cube
  by (reify_floatariths)

concrete_definition c2d uses c2d

interpretation c2d: ode_interpretation true_form UNIV c2d "\<lambda>(x, y). (x*y + y^3 + 2, x\<^sup>2 + 2 * x - 3 * y)::real*real"
  "n::2" for n
  by standard
    (auto simp: c2d_def less_Suc_eq_0_disj nth_Basis_list_prod Basis_list_real_def power3_eq_cube
      mk_ode_ops_def eucl_of_list_prod power2_eq_square inverse_eq_divide intro!: isFDERIV_I)

abbreviation "options \<equiv> ro 2 10 7 2 2 2"

lemma c2d_pi_1: "c2d.guards_invar DIM(real \<times> real)
  [([ysec2 (-200, 0) 0], options), ([xsec2 0 (0, 100)], options), ([xsec2 75 (0, 100)], options),
    ([xsec2 150 (0, 300)], options), ([xsec2 250 (0, 300)], options)]"
  by (auto simp: c2d.guards_invar_def)

lemma c2d_poincare_section_rep[poincare_tac_theorems]:
  "{(300::real, 0::real)..(300, 300)} = {eucl_of_list [300, 0]..eucl_of_list [300, 300]}"
  by (auto simp: eucl_of_list_prod)

lemma c2d_ro: "TAG_reach_optns options" by simp

lemma c2d_start: "TAG_sctn False" by simp

lemma
  notes [poincare_tac_theorems] = c2d_ro c2d_start c2d_pi_1
  shows "\<forall>x\<in>{(29.9, -38) .. (30.1, -36)}.
  c2d.returns_to   {(300, 0) .. (300, 300)} x \<and>
  c2d.poincare_map_from_outside {(300, 0) .. (300, 300)} x \<in> {(300, 70) .. (300, 80)}"
  using [[ode_numerics_trace]]
  by (tactic \<open>poincare_bnds_tac_gen 20 @{thms c2d_def} 30 20 7 10 [(0, 1, "0x000000")] "-" (* "out_p1_vdp_0.out" *)  @{context} 1\<close>)

end

end


(*  Title:      HOL/MicroJava/DFA/Opt.thy
    Author:     Tobias Nipkow
    Copyright   2000 TUM
*)

section \<open>More about Options\<close>

theory Opt
imports Err
begin

definition le :: "'a ord \<Rightarrow> 'a option ord" where
"le r o1 o2 == case o2 of None \<Rightarrow> o1=None |
                              Some y \<Rightarrow> (case o1 of None \<Rightarrow> True
                                                  | Some x \<Rightarrow> x <=_r y)"

definition opt :: "'a set \<Rightarrow> 'a option set" where
"opt A == insert None {x . ? y:A. x = Some y}"

definition sup :: "'a ebinop \<Rightarrow> 'a option ebinop" where
"sup f o1 o2 ==
 case o1 of None \<Rightarrow> OK o2 | Some x \<Rightarrow> (case o2 of None \<Rightarrow> OK o1
     | Some y \<Rightarrow> (case f x y of Err \<Rightarrow> Err | OK z \<Rightarrow> OK (Some z)))"

definition esl :: "'a esl \<Rightarrow> 'a option esl" where
"esl == %(A,r,f). (opt A, le r, sup f)"

lemma unfold_le_opt:
  "o1 <=_(le r) o2 =
  (case o2 of None \<Rightarrow> o1=None |
              Some y \<Rightarrow> (case o1 of None \<Rightarrow> True | Some x \<Rightarrow> x <=_r y))"
apply (unfold lesub_def le_def)
apply (rule refl)
done

lemma le_opt_refl:
  "order r \<Longrightarrow> o1 <=_(le r) o1"
by (simp add: unfold_le_opt split: option.split)

lemma le_opt_trans [rule_format]:
  "order r \<Longrightarrow>
   o1 <=_(le r) o2 \<longrightarrow> o2 <=_(le r) o3 \<longrightarrow> o1 <=_(le r) o3"
apply (simp add: unfold_le_opt split: option.split)
apply (blast intro: order_trans)
done

lemma le_opt_antisym [rule_format]:
  "order r \<Longrightarrow> o1 <=_(le r) o2 \<longrightarrow> o2 <=_(le r) o1 \<longrightarrow> o1=o2"
apply (simp add: unfold_le_opt split: option.split)
apply (blast intro: order_antisym)
done

lemma order_le_opt [intro!,simp]:
  "order r \<Longrightarrow> order(le r)"
apply (subst Semilat.order_def)
apply (blast intro: le_opt_refl le_opt_trans le_opt_antisym)
done

lemma None_bot [iff]:
  "None <=_(le r) ox"
apply (unfold lesub_def le_def)
apply (simp split: option.split)
done

lemma Some_le [iff]:
  "(Some x <=_(le r) ox) = (? y. ox = Some y & x <=_r y)"
apply (unfold lesub_def le_def)
apply (simp split: option.split)
done

lemma le_None [iff]:
  "(ox <=_(le r) None) = (ox = None)"
apply (unfold lesub_def le_def)
apply (simp split: option.split)
done

lemma OK_None_bot [iff]:
  "OK None <=_(Err.le (le r)) x"
  by (simp add: lesub_def Err.le_def le_def split: option.split err.split)

lemma sup_None1 [iff]:
  "x +_(sup f) None = OK x"
  by (simp add: plussub_def sup_def split: option.split)

lemma sup_None2 [iff]:
  "None +_(sup f) x = OK x"
  by (simp add: plussub_def sup_def split: option.split)

lemma None_in_opt [iff]:
  "None : opt A"
by (simp add: opt_def)

lemma Some_in_opt [iff]:
  "(Some x : opt A) = (x:A)"
apply (unfold opt_def)
apply auto
done

lemma semilat_opt [intro, simp]:
  "\<And>L. err_semilat L \<Longrightarrow> err_semilat (Opt.esl L)"
proof (unfold Opt.esl_def Err.sl_def, simp add: split_tupled_all)

  fix A r f
  assume s: "semilat (err A, Err.le r, lift2 f)"

  let ?A0 = "err A"
  let ?r0 = "Err.le r"
  let ?f0 = "lift2 f"

  from s
  obtain
    ord: "order ?r0" and
    clo: "closed ?A0 ?f0" and
    ub1: "\<forall>x\<in>?A0. \<forall>y\<in>?A0. x <=_?r0 x +_?f0 y" and
    ub2: "\<forall>x\<in>?A0. \<forall>y\<in>?A0. y <=_?r0 x +_?f0 y" and
    lub: "\<forall>x\<in>?A0. \<forall>y\<in>?A0. \<forall>z\<in>?A0. x <=_?r0 z \<and> y <=_?r0 z \<longrightarrow> x +_?f0 y <=_?r0 z"
    by (unfold semilat_def) simp

  let ?A = "err (opt A)"
  let ?r = "Err.le (Opt.le r)"
  let ?f = "lift2 (Opt.sup f)"

  from ord
  have "order ?r"
    by simp

  moreover

  have "closed ?A ?f"
  proof (unfold closed_def, intro strip)
    fix x y
    assume x: "x : ?A"
    assume y: "y : ?A"

    { fix a b
      assume ab: "x = OK a" "y = OK b"

      with x
      have a: "\<And>c. a = Some c \<Longrightarrow> c : A"
        by (clarsimp simp add: opt_def)

      from ab y
      have b: "\<And>d. b = Some d \<Longrightarrow> d : A"
        by (clarsimp simp add: opt_def)

      { fix c d assume "a = Some c" "b = Some d"
        with ab x y
        have "c:A & d:A"
          by (simp add: err_def opt_def Bex_def)
        with clo
        have "f c d : err A"
          by (simp add: closed_def plussub_def err_def lift2_def)
        moreover
        fix z assume "f c d = OK z"
        ultimately
        have "z : A" by simp
      } note f_closed = this

      have "sup f a b : ?A"
      proof (cases a)
        case None
        thus ?thesis
          by (simp add: sup_def opt_def) (cases b, simp, simp add: b Bex_def)
      next
        case Some
        thus ?thesis
          by (auto simp add: sup_def opt_def Bex_def a b f_closed split: err.split option.split)
      qed
    }

    thus "x +_?f y : ?A"
      by (simp add: plussub_def lift2_def split: err.split)
  qed

  moreover

  { fix a b c
    assume "a \<in> opt A" "b \<in> opt A" "a +_(sup f) b = OK c"
    moreover
    from ord have "order r" by simp
    moreover
    { fix x y z
      assume "x \<in> A" "y \<in> A"
      hence "OK x \<in> err A \<and> OK y \<in> err A" by simp
      with ub1 ub2
      have "(OK x) <=_(Err.le r) (OK x) +_(lift2 f) (OK y) \<and>
            (OK y) <=_(Err.le r) (OK x) +_(lift2 f) (OK y)"
        by blast
      moreover
      assume "x +_f y = OK z"
      ultimately
      have "x <=_r z \<and> y <=_r z"
        by (auto simp add: plussub_def lift2_def Err.le_def lesub_def)
    }
    ultimately
    have "a <=_(le r) c \<and> b <=_(le r) c"
      by (auto simp add: sup_def le_def lesub_def plussub_def
               dest: order_refl split: option.splits err.splits)
  }

  hence "(\<forall>x\<in>?A. \<forall>y\<in>?A. x <=_?r x +_?f y) \<and> (\<forall>x\<in>?A. \<forall>y\<in>?A. y <=_?r x +_?f y)"
    by (auto simp add: lesub_def plussub_def Err.le_def lift2_def split: err.split)

  moreover

  have "\<forall>x\<in>?A. \<forall>y\<in>?A. \<forall>z\<in>?A. x <=_?r z \<and> y <=_?r z \<longrightarrow> x +_?f y <=_?r z"
  proof (intro strip, elim conjE)
    fix x y z
    assume xyz: "x : ?A" "y : ?A" "z : ?A"
    assume xz: "x <=_?r z"
    assume yz: "y <=_?r z"

    { fix a b c
      assume ok: "x = OK a" "y = OK b" "z = OK c"

      { fix d e g
        assume some: "a = Some d" "b = Some e" "c = Some g"

        with ok xyz
        obtain "OK d:err A" "OK e:err A" "OK g:err A"
          by simp
        with lub
        have "\<lbrakk> (OK d) <=_(Err.le r) (OK g); (OK e) <=_(Err.le r) (OK g) \<rbrakk>
          \<Longrightarrow> (OK d) +_(lift2 f) (OK e) <=_(Err.le r) (OK g)"
          by blast
        hence "\<lbrakk> d <=_r g; e <=_r g \<rbrakk> \<Longrightarrow> \<exists>y. d +_f e = OK y \<and> y <=_r g"
          by simp

        with ok some xyz xz yz
        have "x +_?f y <=_?r z"
          by (auto simp add: sup_def le_def lesub_def lift2_def plussub_def Err.le_def)
      } note this [intro!]

      from ok xyz xz yz
      have "x +_?f y <=_?r z"
        by - (cases a, simp, cases b, simp, cases c, simp, blast)
    }

    with xyz xz yz
    show "x +_?f y <=_?r z"
      by - (cases x, simp, cases y, simp, cases z, simp+)
  qed

  ultimately

  show "semilat (?A,?r,?f)"
    by (unfold semilat_def) simp
qed

lemma top_le_opt_Some [iff]:
  "top (le r) (Some T) = top r T"
apply (unfold top_def)
apply (rule iffI)
 apply blast
apply (rule allI)
apply (case_tac "x")
apply simp+
done

lemma Top_le_conv:
  "\<lbrakk> order r; top r T \<rbrakk> \<Longrightarrow> (T <=_r x) = (x = T)"
apply (unfold top_def)
apply (blast intro: order_antisym)
done

lemma acc_le_optI [intro!]:
  "acc r \<Longrightarrow> acc(le r)"
apply (unfold acc_def lesub_def le_def lesssub_def)
apply (simp add: wf_eq_minimal split: option.split)
apply clarify
apply (case_tac "? a. Some a : Q")
 apply (erule_tac x = "{a . Some a : Q}" in allE)
 apply blast
apply (case_tac "x")
 apply blast
apply blast
done

lemma option_map_in_optionI:
  "\<lbrakk> ox : opt S; !x:S. ox = Some x \<longrightarrow> f x : S \<rbrakk>
  \<Longrightarrow> map_option f ox : opt S"
apply (unfold map_option_case)
apply (simp split: option.split)
apply blast
done

end