section {*I\_epda\_S*}
theory
  I_epda_S

imports
  I_epda_base

begin

record ('state, 'event, 'stack) epdaS_conf =
  epdaS_conf_state :: "'state"
  epdaS_conf_scheduler :: "'event list"
  epdaS_conf_stack :: "'stack list"

definition epdaS_configurations :: "
  ('state, 'event, 'stack) epda
  \<Rightarrow> ('state, 'event, 'stack) epdaS_conf set"
  where
    "epdaS_configurations G \<equiv>
  {\<lparr>epdaS_conf_state = q, epdaS_conf_scheduler = i, epdaS_conf_stack = s\<rparr> | q i s.
  q \<in> epda_states G
  \<and> set i \<subseteq> epda_events G
  \<and> set s \<subseteq> epda_gamma G}"

definition epdaS_initial_configurations :: "
  ('state, 'event, 'stack) epda
  \<Rightarrow> ('state, 'event, 'stack) epdaS_conf set"
  where
    "epdaS_initial_configurations G \<equiv>
  {c.
    epdaS_conf_stack c = [epda_box G]
    \<and> epdaS_conf_state c = epda_initial G}
  \<inter> epdaS_configurations G"

definition epdaS_marking_configurations :: "
  ('state, 'event, 'stack) epda
  \<Rightarrow> ('state, 'event, 'stack) epdaS_conf set"
  where
    "epdaS_marking_configurations G \<equiv>
  {c.
    epdaS_conf_scheduler c = []
    \<and> epdaS_conf_state c \<in> epda_marking G}
  \<inter> epdaS_configurations G"

definition epdaS_marking_condition :: "
  ('state,'event, 'stack) epda
  \<Rightarrow> (('state,'event,'stack) epda_step_label, ('state,'event,'stack) epdaS_conf) derivation
  \<Rightarrow> bool"
  where
    "epdaS_marking_condition G d \<equiv>
  \<exists>i e c.
  d i = Some (pair e c)
  \<and> c \<in> epdaS_marking_configurations G"

definition epdaS_step_relation :: "
  ('state, 'event, 'stack) epda
  \<Rightarrow> ('state, 'event, 'stack) epdaS_conf
  \<Rightarrow> ('state, 'event, 'stack) epda_step_label
  \<Rightarrow> ('state, 'event, 'stack) epdaS_conf
  \<Rightarrow> bool"
  where
    "epdaS_step_relation G c1 e c2 \<equiv>
  e \<in> epda_delta G
  \<and> epdaS_conf_state c1 = edge_src e
  \<and> epdaS_conf_state c2 = edge_trg e
  \<and> epdaS_conf_scheduler c1
      = option_to_list (edge_event e) @ epdaS_conf_scheduler c2
  \<and> (\<exists>w.
     epdaS_conf_stack c1 = edge_pop e @ w
     \<and> epdaS_conf_stack c2 = edge_push e @ w)"

definition epdaS_marked_effect :: "
  ('state,'event, 'stack) epda
  \<Rightarrow> (('state,'event,'stack) epda_step_label, ('state,'event,'stack) epdaS_conf) derivation
  \<Rightarrow> 'event list set"
  where
    "epdaS_marked_effect G d \<equiv>
  {w. \<exists>c.
      d 0 = Some (pair None c)
      \<and> w = epdaS_conf_scheduler c}"

definition epdaS_unmarked_effect :: "
  ('state,'event, 'stack) epda
  \<Rightarrow> (('state,'event,'stack) epda_step_label, ('state,'event,'stack) epdaS_conf) derivation
  \<Rightarrow> 'event list set"
  where
    "epdaS_unmarked_effect G d \<equiv>
  {w. \<exists>c c' i e.
      d 0 = Some (pair None c)
      \<and> d i = Some (pair e c')
      \<and> w @ epdaS_conf_scheduler c' = epdaS_conf_scheduler c}"

definition epdaS_string_state :: "
  ('state, 'event, 'stack) epdaS_conf
  \<Rightarrow> 'event list"
  where
    "epdaS_string_state c \<equiv>
  epdaS_conf_scheduler c"

definition epdaS_get_destinations :: "
  ('state,'event,'stack) epda
  \<Rightarrow> (('state,'event,'stack) epda_step_label, ('state,'event,'stack) epdaS_conf) derivation_configuration
  \<Rightarrow> ('state,'event,'stack) epda_destinations set"
  where
    "epdaS_get_destinations G der_conf \<equiv>
  case der_conf of pair e c \<Rightarrow>
    {state (epdaS_conf_state c)}
    \<union> (case e of None \<Rightarrow> {} | Some e'\<Rightarrow> {edge e'})"

lemma epdaS_inst_AX_initial_configuration_belongs: "
  (\<forall>G. valid_epda G \<longrightarrow> epdaS_initial_configurations G \<subseteq> epdaS_configurations G)"
  apply(clarsimp)
  apply(rename_tac G x)(*strict*)
  apply(simp add: epdaS_initial_configurations_def)
  done

lemma epdaS_inst_AX_step_relation_preserves_belongs: "
  (\<forall>G. valid_epda G \<longrightarrow> (\<forall>c1 e c2. epdaS_step_relation G c1 e c2 \<longrightarrow> c1 \<in> epdaS_configurations G \<longrightarrow> e \<in> epda_step_labels G \<and> c2 \<in> epdaS_configurations G))"
  apply(clarsimp)
  apply(rename_tac G c1 e c2)(*strict*)
  apply(rule context_conjI)
   apply(rename_tac G c1 e c2)(*strict*)
   apply(simp add: epdaS_step_relation_def)
   apply(clarsimp)
   apply(rename_tac G c1 e c2 w)(*strict*)
   apply(simp add: epda_step_labels_def)
  apply(rename_tac G c1 e c2)(*strict*)
  apply(simp add: epda_step_labels_def epdaS_step_relation_def epdaS_configurations_def)
  apply(clarsimp)
  apply(rename_tac G e c2 w)(*strict*)
  apply(case_tac c2)
  apply(rename_tac G e c2 w epdaS_conf_statea epdaS_conf_schedulera epdaS_conf_stacka)(*strict*)
  apply(clarsimp)
  apply(rename_tac G e w epdaS_conf_scheduler)(*strict*)
  apply(simp add: valid_epda_def)
  apply(clarsimp)
  apply(erule_tac
      x="e"
      in ballE)
   apply(rename_tac G e w epdaS_conf_scheduler)(*strict*)
   prefer 2
   apply(force)
  apply(rename_tac G e w epdaS_conf_scheduler)(*strict*)
  apply(simp add: valid_epda_step_label_def)
  apply(clarsimp)
  apply(rename_tac G e w epdaS_conf_scheduler x)(*strict*)
  apply(simp add: may_terminated_by_def append_language_def kleene_star_def)
  apply(clarsimp)
  apply(rename_tac G e w epdaS_conf_scheduler x a aa)(*strict*)
  apply(erule_tac
      P="edge_push e = aa @ [epda_box G]"
      in disjE)
   apply(rename_tac G e w epdaS_conf_scheduler x a aa)(*strict*)
   apply(clarsimp)
   apply(blast)
  apply(rename_tac G e w epdaS_conf_scheduler x a aa)(*strict*)
  apply(clarsimp)
  apply(rename_tac G e w epdaS_conf_scheduler x a)(*strict*)
  apply(blast)
  done

interpretation "epdaS" : loc_autS_0
  (* TSstructure *)
  "valid_epda"
  (* configurations *)
  "epdaS_configurations"
  (* initial_configurations *)
  "epdaS_initial_configurations"
  (* step_labels *)
  "epda_step_labels"
  (* step_relation *)
  "epdaS_step_relation"
  (* effects *)
  "epda_effects"
  (* marking_condition *)
  "epdaS_marking_condition"
  (* marked_effect *)
  "epdaS_marked_effect"
  (* unmarked_effect *)
  "epdaS_unmarked_effect"
  (* destinations *)
  "epda_destinations"
  (* get_destinations *)
  "epdaS_get_destinations"
  apply(simp add: LOCALE_DEFS)
  apply(simp add: epdaS_inst_AX_initial_configuration_belongs epdaS_inst_AX_step_relation_preserves_belongs )
  done

lemma epdaS_inst_AX_string_state_decreases: "
   \<forall>G. valid_epda G \<longrightarrow>
        (\<forall>c1. c1 \<in> epdaS_configurations G \<longrightarrow>
              (\<forall>e c2. epdaS_step_relation G c1 e c2 \<longrightarrow>
                      (\<exists>w. epdaS_string_state c1 = w @ epdaS_string_state c2)))"
  apply(clarsimp)
  apply(rename_tac M c1 e c2)(*strict*)
  apply(simp add: epdaS_string_state_def)
  apply(simp add: epdaS_configurations_def)
  apply(simp add: epdaS_step_relation_def)
  done

lemma epdaS_inst_lang_sound: "
  (\<forall>M. valid_epda M \<longrightarrow> epdaS.unmarked_language M \<subseteq> epda_effects M)"
  apply(simp add: epdaS.unmarked_language_def epda_effects_def epdaS_unmarked_effect_def epdaS_initial_configurations_def epdaS_configurations_def)
  apply(clarsimp)
  apply(rename_tac M x xa d c c' i e)(*strict*)
  apply(subgoal_tac "epdaS.belongs M d")
   apply(rename_tac M x xa d c c' i e)(*strict*)
   prefer 2
   apply(rule epdaS.derivation_initial_belongs)
    apply(rename_tac M x xa d c c' i e)(*strict*)
    apply(force)
   apply(rename_tac M x xa d c c' i e)(*strict*)
   apply(force)
  apply(rename_tac M x xa d c c' i e)(*strict*)
  apply(subgoal_tac "c \<in> epdaS_configurations M")
   apply(rename_tac M x xa d c c' i e)(*strict*)
   prefer 2
   apply(rule epdaS.belongs_configurations)
    apply(rename_tac M x xa d c c' i e)(*strict*)
    apply(force)
   apply(rename_tac M x xa d c c' i e)(*strict*)
   apply(force)
  apply(rename_tac M x xa d c c' i e)(*strict*)
  apply(subgoal_tac "c' \<in> epdaS_configurations M")
   apply(rename_tac M x xa d c c' i e)(*strict*)
   prefer 2
   apply(rule epdaS.belongs_configurations)
    apply(rename_tac M x xa d c c' i e)(*strict*)
    apply(force)
   apply(rename_tac M x xa d c c' i e)(*strict*)
   apply(force)
  apply(rename_tac M x xa d c c' i e)(*strict*)
  apply(simp add: epdaS_configurations_def)
  apply(force)
  done

definition epdaS_get_scheduler :: "
  ('state, 'event, 'stack) epdaS_conf
  \<Rightarrow> 'event list"
  where
    "epdaS_get_scheduler c \<equiv>
  epdaS_conf_scheduler c"

definition epdaS_get_fixed_scheduler_DB :: "
  ('state, 'event, 'stack) epda
  \<Rightarrow> (('state,'event,'stack) epda_step_label, ('state,'event,'stack) epdaS_conf) derivation
  \<Rightarrow> nat
  \<Rightarrow> 'event list"
  where
    "epdaS_get_fixed_scheduler_DB G d n \<equiv>
  []"

definition epdaS_set_unfixed_scheduler_DB :: "
  ('state, 'event, 'stack) epda
  \<Rightarrow> (('state,'event,'stack) epda_step_label, ('state,'event,'stack) epdaS_conf) derivation
  \<Rightarrow> nat
  \<Rightarrow> 'event list
  \<Rightarrow> ('state,'event,'stack) epdaS_conf"
  where
    "epdaS_set_unfixed_scheduler_DB G d n sUF \<equiv>
  (the(get_configuration(d n)))\<lparr>epdaS_conf_scheduler := sUF\<rparr>"

definition epdaS_get_unfixed_scheduler_DB :: "
  ('state, 'event, 'stack) epda
  \<Rightarrow> (('state,'event,'stack) epda_step_label, ('state,'event,'stack) epdaS_conf) derivation
  \<Rightarrow> nat
  \<Rightarrow> 'event list"
  where
    "epdaS_get_unfixed_scheduler_DB G d n \<equiv>
  epdaS_get_scheduler(the(get_configuration(d n)))"

lemma epdaS_inst_AX_marking_condition_implies_existence_of_effect: "
  (\<forall>M. valid_epda M \<longrightarrow> (\<forall>f. epdaS.derivation_initial M f \<longrightarrow> epdaS_marking_condition M f \<longrightarrow> epdaS_marked_effect M f \<noteq> {}))"
  apply(clarsimp)
  apply(rename_tac M f)(*strict*)
  apply(simp add: epdaS_marked_effect_def)
  apply(simp add: epdaS_marking_condition_def)
  apply(clarsimp)
  apply(rename_tac M f i e c)(*strict*)
  apply(simp add: epdaS_marking_configurations_def)
  apply(clarsimp)
  apply(simp add: epdaS_configurations_def)
  apply(clarsimp)
  apply(rename_tac M f i e q s)(*strict*)
  apply(subgoal_tac "\<exists>c. f 0 = Some (pair None c)")
   apply(rename_tac M f i e q s)(*strict*)
   apply(clarsimp)
  apply(rename_tac M f i e q s)(*strict*)
  apply (metis epdaS.derivation_initial_is_derivation epdaS.some_position_has_details_at_0)
  done

lemma epdaS_inst_AX_unmarked_effect_persists: "
  (\<forall>G. valid_epda G \<longrightarrow>
         (\<forall>d. ATS.derivation_initial epdaS_initial_configurations
               epdaS_step_relation G d \<longrightarrow>
              (\<forall>n. epdaS_unmarked_effect G (derivation_take d n)
                   \<subseteq> epdaS_unmarked_effect G d)))"
  apply(clarsimp)
  apply(rename_tac M d n x)(*strict*)
  apply(simp add: epdaS_unmarked_effect_def)
  apply(clarsimp)
  apply(rename_tac M d n x c c' i e)(*strict*)
  apply(case_tac "i\<le>n")
   apply(rename_tac M d n x c c' i e)(*strict*)
   prefer 2
   apply(simp add: derivation_take_def)
  apply(rename_tac M d n x c c' i e)(*strict*)
  apply(rule_tac
      x="c"
      in exI)
  apply(rule conjI)
   apply(rename_tac M d n x c c' i e)(*strict*)
   apply(simp add: derivation_take_def)
  apply(rename_tac M d n x c c' i e)(*strict*)
  apply(rule_tac
      x="c'"
      in exI)
  apply(rule conjI)
   apply(rename_tac M d n x c c' i e)(*strict*)
   apply(simp add: derivation_take_def)
   apply(rule_tac
      x="i"
      in exI)
   apply(rule_tac
      x="e"
      in exI)
   apply(clarsimp)
  apply(rename_tac M d n x c c' i e)(*strict*)
  apply(force)
  done

lemma epdaS_inst_AX_effect_inclusion1: "
  (\<forall>M f. epdaS_marking_condition M f \<longrightarrow> epdaS_marked_effect M f \<subseteq> epdaS_unmarked_effect M f)"
  apply(clarsimp)
  apply(rename_tac M f x)(*strict*)
  apply(simp add: epdaS_marking_condition_def epdaS_marked_effect_def epdaS_unmarked_effect_def epdaS_marking_configurations_def)
  apply(clarsimp)
  apply(rename_tac M f i c e ca)(*strict*)
  apply(force)
  done

lemma epdaS_inst_accept: "
  \<forall>G. valid_epda G \<longrightarrow> (\<forall>d. epdaS.derivation_initial G d \<longrightarrow> epdaS_marking_condition G d = (\<exists>i e c. d i = Some (pair e c) \<and> c \<in> epdaS_marking_configurations G))"
  apply(clarsimp)
  apply(rename_tac G d)(*strict*)
  apply(simp add: epdaS_marking_condition_def epdaS_marking_configurations_def)
  done

lemma epdaS_inst_AX_marking_can_not_be_disabled: "
  (\<forall>G d. (\<exists>n. epdaS_marking_condition G (derivation_take d n)) \<longrightarrow> epdaS_marking_condition G d)"
  apply(clarsimp)
  apply(rename_tac G d n)(*strict*)
  apply(simp add: epdaS_marking_condition_def derivation_take_def)
  apply(clarsimp)
  apply(rename_tac G d n i e c)(*strict*)
  apply(case_tac "i\<le>n")
   apply(rename_tac G d n i e c)(*strict*)
   prefer 2
   apply(force)
  apply(rename_tac G d n i e c)(*strict*)
  apply(clarsimp)
  apply(rule_tac
      x="i"
      in exI)
  apply(rule_tac
      x="e"
      in exI)
  apply(rule_tac
      x="c"
      in exI)
  apply(force)
  done

lemma epdaS_inst_AX_marked_effect_persists: "
  (\<forall>G d n. epdaS_marked_effect G (derivation_take d n) \<subseteq> epdaS_marked_effect G d)"
  apply(simp add: epdaS_marked_effect_def derivation_take_def)
  done

lemma epdaS_inst_lang_finite: "
  (\<forall>G. valid_epda G \<longrightarrow> epdaS.finite_marked_language G = epdaS.marked_language G)"
  apply(clarsimp)
  apply(rename_tac G)(*strict*)
  apply(simp add: epdaS.finite_marked_language_def epdaS.marked_language_def)
  apply(rule order_antisym)
   apply(rename_tac G)(*strict*)
   apply(clarsimp)
   apply(rename_tac G x d n)(*strict*)
   apply(rule_tac
      x="d"
      in exI)
   apply(clarsimp)
   apply(rule epdaS.derivation_initial_is_derivation)
   apply(force)
  apply(rename_tac G)(*strict*)
  apply(clarsimp)
  apply(rename_tac G x d)(*strict*)
  apply(simp add: epdaS_marking_condition_def)
  apply(clarsimp)
  apply(rename_tac G x d i e c)(*strict*)
  apply(rule_tac
      x="derivation_take d i"
      in exI)
  apply(rule conjI)
   apply(rename_tac G x d i e c)(*strict*)
   apply (metis epdaS.derivation_take_preserves_derivation_initial)
  apply(rename_tac G x d i e c)(*strict*)
  apply(rule conjI)
   apply(rename_tac G x d i e c)(*strict*)
   apply(simp add: epdaS_marked_effect_def derivation_take_def)
  apply(rename_tac G x d i e c)(*strict*)
  apply(rule conjI)
   apply(rename_tac G x d i e c)(*strict*)
   apply(rule_tac
      x="i"
      in exI)
   apply(rule_tac
      x="e"
      in exI)
   apply(rule_tac
      x="c"
      in exI)
   apply(simp add: derivation_take_def)
  apply(rename_tac G x d i e c)(*strict*)
  apply(rule_tac
      x="i"
      in exI)
  apply (metis not_Some_eq maximum_of_domain_derivation_take)
  done

lemma epdaS_inst_AX_unmarked_language_finite: "
  (\<forall>G. valid_epda G \<longrightarrow> epdaS.finite_unmarked_language G = epdaS.unmarked_language G)"
  apply(clarsimp)
  apply(rename_tac G)(*strict*)
  apply(simp add: epdaS.finite_unmarked_language_def epdaS.unmarked_language_def)
  apply(rule order_antisym)
   apply(rename_tac G)(*strict*)
   apply(clarsimp)
   apply(rename_tac G x d n)(*strict*)
   apply(rule_tac
      x="d"
      in exI)
   apply(clarsimp)
   apply(rule epdaS.derivation_initial_is_derivation)
   apply(force)
  apply(rename_tac G)(*strict*)
  apply(clarsimp)
  apply(rename_tac G x d)(*strict*)
  apply(simp add: epdaS_unmarked_effect_def)
  apply(clarsimp)
  apply(rename_tac G x d c c' i e)(*strict*)
  apply(rule_tac
      x="derivation_take d i"
      in exI)
  apply(rule conjI)
   apply(rename_tac G x d c c' i e)(*strict*)
   apply (metis epdaS.derivation_take_preserves_derivation_initial)
  apply(rename_tac G x d c c' i e)(*strict*)
  apply(rule conjI)
   apply(rename_tac G x d c c' i e)(*strict*)
   apply(rule_tac
      x="c"
      in exI)
   apply(rule conjI)
    apply(rename_tac G x d c c' i e)(*strict*)
    apply(simp add: derivation_take_def)
   apply(rename_tac G x d c c' i e)(*strict*)
   apply(rule_tac
      x="c'"
      in exI)
   apply(rule conjI)
    apply(rename_tac G x d c c' i e)(*strict*)
    apply(rule_tac
      x="i"
      in exI)
    apply(simp add: derivation_take_def)
   apply(rename_tac G x d c c' i e)(*strict*)
   apply(force)
  apply(rename_tac G x d c c' i e)(*strict*)
  apply(rule_tac
      x="i"
      in exI)
  apply (metis not_Some_eq maximum_of_domain_derivation_take)
  done

lemma epdaS_inst_ATS_Language_axioms: "
  ATS_Language_axioms valid_epda epdaS_initial_configurations
     epdaS_step_relation epda_effects epdaS_marking_condition
     epdaS_marked_effect epdaS_unmarked_effect "
  apply(simp add: ATS_Language_axioms_def)
  apply(simp add: epdaS_inst_AX_marking_condition_implies_existence_of_effect epdaS_inst_lang_sound epdaS_inst_AX_effect_inclusion1 epdaS_inst_AX_unmarked_effect_persists )
  done

lemma epdaS_inst_ATS_Language_by_Finite_Derivations_axioms: "
  ATS_Language_by_Finite_Derivations_axioms valid_epda
     epdaS_initial_configurations epdaS_step_relation
     epdaS_marking_condition epdaS_marked_effect epdaS_unmarked_effect"
  apply(simp add: ATS_Language_by_Finite_Derivations_axioms_def)
  apply(simp add: epdaS_inst_lang_finite epdaS_inst_AX_unmarked_language_finite )
  done

lemma epdaS_inst_ATS_String_State_Modification_axioms: "
  ATS_String_State_Modification_axioms valid_epda epdaS_configurations
     epdaS_step_relation True epdaS_string_state"
  apply(simp add: ATS_String_State_Modification_axioms_def)
  apply(simp add: epdaS_inst_AX_string_state_decreases )
  done

interpretation "epdaS" : loc_autS_1
  (* TSstructure *)
  "valid_epda"
  (* configurations *)
  "epdaS_configurations"
  (* initial_configurations *)
  "epdaS_initial_configurations"
  (* step_labels *)
  "epda_step_labels"
  (* step_relation *)
  "epdaS_step_relation"
  (* effects *)
  "epda_effects"
  (* marking_condition *)
  "epdaS_marking_condition"
  (* marked_effect *)
  "epdaS_marked_effect"
  (* unmarked_effect *)
  "epdaS_unmarked_effect"
  (* destinations *)
  "epda_destinations"
  (* get_destinations *)
  "epdaS_get_destinations"
  (* decreasing *)
  "True"
  (* string_state *)
  "epdaS_string_state"
  apply(simp add: LOCALE_DEFS)
  apply(simp add: epdaS_inst_AX_initial_configuration_belongs epdaS_inst_AX_step_relation_preserves_belongs )
  apply(simp add: epdaS_inst_ATS_Language_axioms epdaS_inst_ATS_Language_by_Finite_Derivations_axioms epdaS_inst_ATS_String_State_Modification_axioms)
  done

lemma epdaS_inst_hlp_get_unfixed_scheduler_DB_constructs_right_quotient: "
  valid_epda G
  \<Longrightarrow> epdaS.derivation G d
  \<Longrightarrow> epdaS.belongs G d
  \<Longrightarrow> d n \<noteq> None
  \<Longrightarrow> i \<le> j
  \<Longrightarrow> j \<le> n
  \<Longrightarrow> suffix (epdaS_get_unfixed_scheduler_DB G d i) (epdaS_get_unfixed_scheduler_DB G d j)"
  apply(induct "j-i" arbitrary: i j)
   apply(rename_tac i j)(*strict*)
   apply(clarsimp)
   apply(rename_tac i y)(*strict*)
   apply(simp add: suffix_def)
  apply(rename_tac x i j)(*strict*)
  apply(clarsimp)
  apply(rename_tac x i j y)(*strict*)
  apply(erule_tac
      x="Suc i"
      in meta_allE)
  apply(erule_tac
      x="j"
      in meta_allE)
  apply(clarsimp)
  apply(erule meta_impE)
   apply(rename_tac x i j y)(*strict*)
   apply(force)
  apply(rename_tac x i j y)(*strict*)
  apply(erule meta_impE)
   apply(rename_tac x i j y)(*strict*)
   apply(force)
  apply(rename_tac x i j y)(*strict*)
  apply(rule_tac
      b="epdaS_get_unfixed_scheduler_DB G d (Suc i)"
      in suffix_trans)
   apply(rename_tac x i j y)(*strict*)
   defer
   apply(force)
  apply(rename_tac x i j y)(*strict*)
  apply(thin_tac "epdaS_get_unfixed_scheduler_DB G d (Suc i) \<sqsupseteq> epdaS_get_unfixed_scheduler_DB G d j")
  apply(simp add: epdaS_get_unfixed_scheduler_DB_def suffix_def)
  apply(subgoal_tac "\<exists>e1 e2 c1 c2. d i = Some (pair e1 c1) \<and> d (Suc i) = Some (pair (Some e2) c2) \<and> epdaS_step_relation G c1 e2 c2")
   apply(rename_tac x i j y)(*strict*)
   prefer 2
   apply(rule_tac
      m="n"
      in epdaS.step_detail_before_some_position)
     apply(rename_tac x i j y)(*strict*)
     apply(force)
    apply(rename_tac x i j y)(*strict*)
    apply(force)
   apply(rename_tac x i j y)(*strict*)
   apply(force)
  apply(rename_tac x i j y)(*strict*)
  apply(clarsimp)
  apply(rename_tac x i j y e1 e2 c1 c2)(*strict*)
  apply(simp add: epdaS_get_scheduler_def get_configuration_def epdaS_step_relation_def)
  done

lemma epdaS_inst_AX_get_scheduler_closed: "
  (\<forall>G. valid_epda G \<longrightarrow> (\<forall>c. c \<in> epdaS_configurations G \<longrightarrow> epdaS_get_scheduler c \<in> epda_effects G))"
  apply(simp add: epdaS_configurations_def epda_effects_def epdaS_get_scheduler_def)
  apply(clarsimp)
  apply(rename_tac G x q i s)(*strict*)
  apply(force)
  done

lemma epdaS_inst_AX_get_fixed_scheduler_DB_restrict: "
  \<forall>G. valid_epda G \<longrightarrow> (\<forall>x n. x \<le> n \<longrightarrow> (\<forall>d1. epdaS.derivation G d1 \<longrightarrow> (\<forall>d2. epdaS_get_fixed_scheduler_DB G (derivation_append d1 d2 n) x = epdaS_get_fixed_scheduler_DB G d1 x)))"
  apply(clarsimp)
  apply(rename_tac G x n d1 d2)(*strict*)
  apply(simp add: epdaS_get_fixed_scheduler_DB_def epdaS_get_scheduler_def)
  done

lemma epdaS_inst_AX_get_unfixed_scheduler_DB_invariant_under_derivation_take: "
  \<forall>G. valid_epda G \<longrightarrow> (\<forall>d. epdaS.derivation_initial G d \<longrightarrow> (\<forall>n m. n \<le> m \<longrightarrow> epdaS_get_unfixed_scheduler_DB G d n = epdaS_get_unfixed_scheduler_DB G (derivation_take d m) n))"
  apply(clarsimp)
  apply(rename_tac G d n m)(*strict*)
  apply(simp add: epdaS_get_unfixed_scheduler_DB_def)
  apply(simp add: derivation_take_def)
  done

lemma epdaS_inst_AX_get_unfixed_scheduler_DB_closed: "
  (\<forall>G. valid_epda G \<longrightarrow> (\<forall>d. epdaS.derivation G d \<longrightarrow> epdaS.belongs G d \<longrightarrow> (\<forall>n. (\<exists>e c. d n = Some (pair e c)) \<longrightarrow> epdaS_get_unfixed_scheduler_DB G d n \<in> epda_effects G)))"
  apply(clarsimp)
  apply(rename_tac G d n e c)(*strict*)
  apply(simp add: epda_effects_def epdaS_get_unfixed_scheduler_DB_def)
  apply(simp add: get_configuration_def)
  apply(subgoal_tac "c \<in> epdaS_configurations G")
   apply(rename_tac G d n e c)(*strict*)
   prefer 2
   apply(rule epdaS.belongs_configurations)
    apply(rename_tac G d n e c)(*strict*)
    apply(force)
   apply(rename_tac G d n e c)(*strict*)
   apply(force)
  apply(rename_tac G d n e c)(*strict*)
  apply(simp add: epdaS_configurations_def epda_effects_def epdaS_get_scheduler_def)
  apply(clarsimp)
  apply(rename_tac G d n e x q i s)(*strict*)
  apply(force)
  done

lemma epdaS_inst_AX_empty_scheduler_in_schedulers: "
  (\<forall>G. valid_epda G \<longrightarrow> [] \<in> epda_effects G)"
  apply(clarsimp)
  apply(rename_tac G)(*strict*)
  apply(simp add: epda_effects_def)
  done

lemma epdaS_inst_AX_extend_scheduler_closed: "
  (\<forall>G. valid_epda G \<longrightarrow> (\<forall>sE. sE \<in> epda_effects G \<longrightarrow> (\<forall>s. s \<in> epda_effects G \<longrightarrow> sE @ s \<in> epda_effects G)))"
  apply(clarsimp)
  apply(rename_tac G sE s)(*strict*)
  apply(simp add: epda_effects_def)
  done

lemma epdaS_inst_AX_join_scheduler_fragments_foldl_split: "
  (\<forall>w v. foldl (@) (foldl (@) [] w) v = foldl (@) [] w @ foldl (@) [] v)"
  apply(clarsimp)
  apply(rename_tac w v)(*strict*)
  apply (metis concat_conv_foldl foldl_conv_concat)
  done

lemma epdaS_inst_AX_foldl_join_scheduler_fragments: "
  (\<forall>G. valid_epda G \<longrightarrow> (\<forall>sE. sE \<in> epda_effects G \<longrightarrow> (\<forall>w. set w \<subseteq> epda_effects G \<longrightarrow> foldl (@) sE w = sE @ foldl (@) [] w)))"
  apply(clarsimp)
  apply(rename_tac G sE w)(*strict*)
  apply (metis concat_conv_foldl foldl_conv_concat)
  done

lemma epdaS_inst_ATS_Scheduler_Fragment_axioms: "
  ATS_Scheduler_Fragment_axioms valid_epda epda_effects
     epda_empty_scheduler_fragment (@)"
  apply(simp add: ATS_Scheduler_Fragment_axioms_def)
  apply(simp add: epdaS_inst_AX_join_scheduler_fragments_foldl_split epdaS_inst_AX_extend_scheduler_closed epdaS_inst_AX_foldl_join_scheduler_fragments )
  apply(rule epdaS_inst_AX_empty_scheduler_in_schedulers)
  done

lemma epdaS_inst_AX_extend_unfixed_scheduler_unfixed_scheduler_right_quotient_empty: "
  (\<forall>G. valid_epda G \<longrightarrow> (\<forall>sUF. sUF \<in> epda_effects G \<longrightarrow> the (right_quotient_word sUF []) = sUF))"
  apply(clarsimp)
  apply(rename_tac G sUF)(*strict*)
  apply(simp add: right_quotient_word_def)
  done

lemma epdaS_inst_AX_unfixed_scheduler_right_quotient_all: "
  (\<forall>G. valid_epda G \<longrightarrow> (\<forall>sUF. sUF \<in> epda_effects G \<longrightarrow> right_quotient_word sUF sUF = Some []))"
  apply(clarsimp)
  apply(rename_tac G sUF)(*strict*)
  apply(simp add: right_quotient_word_def)
  done

lemma epdaS_inst_ATS_SchedUF_Basic_axioms: "
  ATS_SchedUF_Basic_axioms valid_epda epda_effects epda_empty_scheduler_fragment
     epda_effects epda_empty_unfixed_scheduler right_quotient_word (@)
     epda_unfixed_scheduler_extendable"
  apply(simp add: ATS_SchedUF_Basic_axioms_def)
  apply(simp add: epdaS_inst_AX_empty_scheduler_in_schedulers epdaS_inst_AX_extend_unfixed_scheduler_unfixed_scheduler_right_quotient_empty epdaS_inst_AX_unfixed_scheduler_right_quotient_all epdaS_inst_AX_extend_scheduler_closed )
  done

lemma epdaS_inst_AX_unfixed_scheduler_right_quotient_closed_on_extendable_get_unfixed_scheduler_DB: "
  (\<forall>G. valid_epda G \<longrightarrow> (\<forall>d. epdaS.derivation_initial G d \<longrightarrow> (\<forall>n. (\<exists>y. d n = Some y) \<longrightarrow> (\<forall>j i. i \<le> j \<longrightarrow> j \<le> n \<longrightarrow> the (right_quotient_word (epdaS_get_unfixed_scheduler_DB G d i) (epdaS_get_unfixed_scheduler_DB G d j)) \<in> epda_effects G))))"
  apply(clarsimp)
  apply(rename_tac G d n y j i)(*strict*)
  apply(simp add: epda_effects_def)
  apply(simp add: epdaS_get_unfixed_scheduler_DB_def epdaS_get_scheduler_def)
  apply(subgoal_tac "\<exists>e c. d i = Some (pair e c)")
   apply(rename_tac G d n y j i)(*strict*)
   apply(subgoal_tac "\<exists>e c. d j = Some (pair e c)")
    apply(rename_tac G d n y j i)(*strict*)
    apply(clarsimp)
    apply(rename_tac G d n y j i x e ea c ca)(*strict*)
    apply(simp add: get_configuration_def)
    apply(subgoal_tac "\<exists>w. epdaS_string_state c = w @ epdaS_string_state ca")
     apply(rename_tac G d n y j i x e ea c ca)(*strict*)
     prefer 2
     apply(rule_tac
      j="j-i"
      in epdaS.derivation_monotonically_dec)
          apply(rename_tac G d n y j i x e ea c ca)(*strict*)
          apply(force)
         apply(rename_tac G d n y j i x e ea c ca)(*strict*)
         apply(force)
        apply(rename_tac G d n y j i x e ea c ca)(*strict*)
        apply(rule epdaS.derivation_initial_belongs)
         apply(rename_tac G d n y j i x e ea c ca)(*strict*)
         apply(force)
        apply(rename_tac G d n y j i x e ea c ca)(*strict*)
        apply(force)
       apply(rename_tac G d n y j i x e ea c ca)(*strict*)
       apply(rule epdaS.derivation_initial_is_derivation)
       apply(force)
      apply(rename_tac G d n y j i x e ea c ca)(*strict*)
      apply(force)
     apply(rename_tac G d n y j i x e ea c ca)(*strict*)
     apply(force)
    apply(rename_tac G d n y j i x e ea c ca)(*strict*)
    apply(clarsimp)
    apply(rename_tac G d n y j i x e ea c ca w)(*strict*)
    apply(subgoal_tac "right_quotient_word (epdaS_conf_scheduler c) (epdaS_conf_scheduler ca) = Some w")
     apply(rename_tac G d n y j i x e ea c ca w)(*strict*)
     prefer 2
     apply(rule right_quotient_word_Some_by_append)
     apply(simp add: get_configuration_def epdaS_string_state_def epdaS_get_scheduler_def)
    apply(rename_tac G d n y j i x e ea c ca w)(*strict*)
    apply(clarsimp)
    apply(simp add: get_configuration_def epdaS_string_state_def epdaS_get_scheduler_def)
    apply(rule_tac
      A="set (epdaS_conf_scheduler c)"
      in set_mp)
     apply(rename_tac G d n y j i x e ea c ca w)(*strict*)
     apply(subgoal_tac "c \<in> epdaS_configurations G")
      apply(rename_tac G d n y j i x e ea c ca w)(*strict*)
      apply(simp add: epdaS_configurations_def)
      apply(clarsimp)
     apply(rename_tac G d n y j i x e ea c ca w)(*strict*)
     apply(rule epdaS.belongs_configurations)
      apply(rename_tac G d n y j i x e ea c ca w)(*strict*)
      apply(rule epdaS.derivation_initial_belongs)
       apply(rename_tac G d n y j i x e ea c ca w)(*strict*)
       apply(force)
      apply(rename_tac G d n y j i x e ea c ca w)(*strict*)
      apply(force)
     apply(rename_tac G d n y j i x e ea c ca w)(*strict*)
     apply(force)
    apply(rename_tac G d n y j i x e ea c ca w)(*strict*)
    apply(force)
   apply(rename_tac G d n y j i)(*strict*)
   apply(rule_tac epdaS.pre_some_position_is_some_position)
     apply(rename_tac G d n y j i)(*strict*)
     apply(rule epdaS.derivation_initial_is_derivation)
     apply(force)
    apply(rename_tac G d n y j i)(*strict*)
    apply(force)
   apply(rename_tac G d n y j i)(*strict*)
   apply(force)
  apply(rename_tac G d n y j i)(*strict*)
  apply(rule_tac epdaS.pre_some_position_is_some_position)
    apply(rename_tac G d n y j i)(*strict*)
    apply(rule epdaS.derivation_initial_is_derivation)
    apply(force)
   apply(rename_tac G d n y j i)(*strict*)
   apply(force)
  apply(rename_tac G d n y j i)(*strict*)
  apply(force)
  done

lemma epdaS_inst_AX_set_unfixed_scheduler_DB_preserves_initial_configurations: "
  (\<forall>G. valid_epda G \<longrightarrow> (\<forall>d. epdaS.derivation G d \<longrightarrow> (\<forall>c. d 0 = Some (pair None c) \<longrightarrow> c \<in> epdaS_initial_configurations G \<longrightarrow> (\<forall>sUF. sUF \<in> epda_effects G \<longrightarrow> epdaS_set_unfixed_scheduler_DB G d 0 sUF \<in> epdaS_initial_configurations G))))"
  apply(clarsimp)
  apply(rename_tac G d c sUF)(*strict*)
  apply(simp add: epdaS_set_unfixed_scheduler_DB_def get_configuration_def epdaS_initial_configurations_def epdaS_configurations_def epda_effects_def)
  apply(clarsimp)
  done

lemma epdaS_inst_ATS_SchedUF_DB_axioms: "
  ATS_SchedUF_DB_axioms valid_epda epdaS_configurations
     epdaS_initial_configurations epda_step_labels epdaS_step_relation
     epda_effects epda_effects right_quotient_word
     epda_unfixed_scheduler_extendable epdaS_set_unfixed_scheduler_DB
     epdaS_get_unfixed_scheduler_DB"
  apply(simp add: ATS_SchedUF_DB_axioms_def)
  apply(rule conjI)
   apply(rule epdaS_inst_AX_unfixed_scheduler_right_quotient_closed_on_extendable_get_unfixed_scheduler_DB)
  apply(simp add: epdaS_inst_AX_get_unfixed_scheduler_DB_closed epdaS_inst_AX_set_unfixed_scheduler_DB_preserves_initial_configurations epdaS_inst_AX_get_unfixed_scheduler_DB_invariant_under_derivation_take )
  done

lemma epdaS_inst_ATS_SchedF_Basic_axioms: "
  ATS_SchedF_Basic_axioms valid_epda epda_fixed_schedulers
     epda_empty_fixed_scheduler"
  apply(simp add: ATS_SchedF_Basic_axioms_def)
  done

lemma epdaS_inst_AX_get_fixed_scheduler_DB_in_fixed_schedulers: "
  (\<forall>G. valid_epda G \<longrightarrow> (\<forall>d. epdaS.derivation G d \<longrightarrow> epdaS.belongs G d \<longrightarrow> (\<forall>n. (\<exists>y. d n = Some y) \<longrightarrow> epdaS_get_fixed_scheduler_DB G d n = [])))"
  apply(clarsimp)
  apply(rename_tac G d n y)(*strict*)
  apply(simp add: epdaS_get_fixed_scheduler_DB_def)
  done

lemma epdaS_inst_ATS_SchedF_DB_axioms: "
  ATS_SchedF_DB_axioms valid_epda epdaS_configurations epda_step_labels
     epdaS_step_relation epda_fixed_schedulers
     epda_fixed_scheduler_extendable epdaS_get_fixed_scheduler_DB"
  apply(simp add: ATS_SchedF_DB_axioms_def)
  apply(simp add: epdaS_inst_AX_get_fixed_scheduler_DB_restrict epdaS_inst_AX_get_fixed_scheduler_DB_in_fixed_schedulers )
  done

lemma epdaS_inst_ATS_Sched_axioms: "
  ATS_Sched_axioms valid_epda epdaS_configurations epda_effects
     epda_empty_scheduler_fragment (@) epda_effects epda_effects
     epda_empty_scheduler epdaS_get_scheduler (@)"
  apply(simp add: ATS_Sched_axioms_def)
  apply(simp add: epdaS_inst_AX_empty_scheduler_in_schedulers epdaS_inst_AX_get_scheduler_closed epdaS_inst_AX_extend_scheduler_closed )
  done

lemma epdaS_inst_ATS_Sched_Basic_axioms: "
  ATS_Sched_Basic_axioms valid_epda epda_fixed_schedulers
     epda_fixed_scheduler_extendable epda_effects
     epda_unfixed_scheduler_extendable epda_effects (@)"
  apply(simp add: ATS_Sched_Basic_axioms_def)
  done

interpretation "epdaS" : loc_autS_2
  (* TSstructure *)
  "valid_epda"
  (* configurations *)
  "epdaS_configurations"
  (* initial_configurations *)
  "epdaS_initial_configurations"
  (* step_labels *)
  "epda_step_labels"
  (* step_relation *)
  "epdaS_step_relation"
  (* effects *)
  "epda_effects"
  (* marking_condition *)
  "epdaS_marking_condition"
  (* marked_effect *)
  "epdaS_marked_effect"
  (* unmarked_effect *)
  "epdaS_unmarked_effect"
  (* destinations *)
  "epda_destinations"
  (* get_destinations *)
  "epdaS_get_destinations"
  (* decreasing *)
  "True"
  (* string_state *)
  "epdaS_string_state"
  (* fixed_schedulers *)
  epda_fixed_schedulers
  (* empty_fixed_scheduler *)
  epda_empty_fixed_scheduler
  (* fixed_scheduler_extendable *)
  epda_fixed_scheduler_extendable
  (* scheduler_fragments *)
  "epda_effects"
  (* empty_scheduler_fragment *)
  epda_empty_scheduler_fragment
  (* join_scheduler_fragments *)
  "append"
  (* unfixed_schedulers *)
  "epda_effects"
  (* empty_unfixed_scheduler *)
  epda_empty_unfixed_scheduler
  (* unfixed_scheduler_right_quotient_word *)
  "right_quotient_word"
  (* extend_unfixed_scheduler *)
  "append"
  (* unfixed_scheduler_extendable *)
  epda_unfixed_scheduler_extendable
  (* schedulers *)
  "epda_effects"
  (* initial_schedulers *)
  "epda_effects"
  (* empty_scheduler *)
  epda_empty_scheduler
  (* get_scheduler *)
  "epdaS_get_scheduler"
  (* join_fixed_scheduler_unfixed_scheduler *)
  "append"
  (* extend_scheduler *)
  "append"
  (* set_unfixed_scheduler_DB *)
  "epdaS_set_unfixed_scheduler_DB"
  (* get_unfixed_scheduler_DB *)
  "epdaS_get_unfixed_scheduler_DB"
  (* get_fixed_scheduler_DB *)
  "epdaS_get_fixed_scheduler_DB"
  apply(simp add: LOCALE_DEFS)
  apply(simp add: epdaS_inst_AX_initial_configuration_belongs epdaS_inst_AX_step_relation_preserves_belongs )
  apply(simp add: epdaS_inst_ATS_Language_by_Finite_Derivations_axioms epdaS_inst_ATS_String_State_Modification_axioms epdaS_inst_ATS_Language_axioms )
  apply(simp add: epdaS_inst_ATS_Scheduler_Fragment_axioms epdaS_inst_ATS_SchedUF_Basic_axioms epdaS_inst_ATS_SchedUF_DB_axioms epdaS_inst_ATS_SchedF_Basic_axioms epdaS_inst_ATS_SchedF_DB_axioms epdaS_inst_ATS_Sched_axioms epdaS_inst_ATS_Sched_Basic_axioms )
  done

lemma epdaS_inst_AX_join_fixed_scheduler_unfixed_scheduler_closed_prime: "
  (\<forall>G. valid_epda G \<longrightarrow> (\<forall>d. epdaS.derivation_initial G d \<longrightarrow> (\<forall>n. (\<exists>y. d n = Some y) \<longrightarrow> epdaS_get_fixed_scheduler_DB G d n @ epdaS_get_unfixed_scheduler_DB G d n \<in> epda_effects G)))"
  apply(clarsimp)
  apply(rename_tac G d n y)(*strict*)
  apply(simp add: epdaS_get_scheduler_def epdaS_get_fixed_scheduler_DB_def epdaS_get_unfixed_scheduler_DB_def epda_effects_def)
  apply(case_tac y)
  apply(rename_tac G d n y option b)(*strict*)
  apply(clarsimp)
  apply(rename_tac G d n option b x)(*strict*)
  apply(simp add: get_configuration_def)
  apply(subgoal_tac "b \<in> epdaS_configurations G")
   apply(rename_tac G d n option b x)(*strict*)
   apply(simp add: epdaS_configurations_def)
   apply(clarsimp)
   apply(rename_tac G d n option x q i s)(*strict*)
   apply(force)
  apply(rename_tac G d n option b x)(*strict*)
  apply(rule epdaS.belongs_configurations)
   apply(rename_tac G d n option b x)(*strict*)
   apply(rule epdaS.derivation_initial_belongs)
    apply(rename_tac G d n option b x)(*strict*)
    apply(force)
   apply(rename_tac G d n option b x)(*strict*)
   apply(force)
  apply(rename_tac G d n option b x)(*strict*)
  apply(force)
  done

lemma epdaS_inst_AX_get_fixed_scheduler_DB_and_get_unfixed_scheduler_DB_vs_get_scheduler_nth: "
  (\<forall>G. valid_epda G \<longrightarrow> (\<forall>d. epdaS.derivation G d \<longrightarrow> (\<forall>n. (\<exists>y. d n = Some y) \<longrightarrow> epdaS_get_fixed_scheduler_DB G d n @ epdaS_get_unfixed_scheduler_DB G d n = ATS_Sched.get_scheduler_nth epdaS_get_scheduler d n)))"
  apply(clarsimp)
  apply(rename_tac G d n y)(*strict*)
  apply(simp add: epdaS_get_scheduler_def epdaS_get_fixed_scheduler_DB_def epdaS_get_unfixed_scheduler_DB_def epda_effects_def)
  apply(case_tac y)
  apply(rename_tac G d n y option b)(*strict*)
  apply(clarsimp)
  apply(rename_tac G d n option b)(*strict*)
  apply(simp add: get_configuration_def)
  apply(simp add: epdaS.get_scheduler_nth_def)
  apply(simp add: get_configuration_def)
  apply(simp add: epdaS_get_scheduler_def epdaS_get_fixed_scheduler_DB_def epdaS_get_unfixed_scheduler_DB_def epda_effects_def)
  done

lemma epdaS_inst_AX_sched_modification_preserves_steps: "
  (\<forall>G. valid_epda G \<longrightarrow> (\<forall>dh n. maximum_of_domain dh n \<longrightarrow> epdaS.derivation G dh \<longrightarrow> epdaS.belongs G dh \<longrightarrow> (\<forall>sUF. sUF \<in> epda_effects G \<longrightarrow> (\<forall>m e2 c2. dh (Suc m) = Some (pair (Some e2) c2) \<longrightarrow> (\<forall>e1 c1. dh m = Some (pair e1 c1) \<longrightarrow> epdaS_step_relation G c1 e2 c2 \<longrightarrow> epdaS_step_relation G (epdaS_set_unfixed_scheduler_DB G dh m (the (right_quotient_word (epdaS_get_unfixed_scheduler_DB G dh m) (epdaS_get_unfixed_scheduler_DB G dh n)) @ sUF)) e2 (epdaS_set_unfixed_scheduler_DB G dh (Suc m) (the (right_quotient_word (epdaS_get_unfixed_scheduler_DB G dh (Suc m)) (epdaS_get_unfixed_scheduler_DB G dh n)) @ sUF)))))))"
  apply(clarsimp)
  apply(rename_tac G dh n sUF m e2 c2 e1 c1)(*strict*)
  apply(simp add: epdaS_set_unfixed_scheduler_DB_def get_configuration_def epdaS_get_unfixed_scheduler_DB_def)
  apply(subgoal_tac "\<exists>e c. dh n = Some (pair e c)")
   apply(rename_tac G dh n sUF m e2 c2 e1 c1)(*strict*)
   prefer 2
   apply(rule epdaS.some_position_has_details_before_max_dom)
     apply(rename_tac G dh n sUF m e2 c2 e1 c1)(*strict*)
     apply(simp add: epdaS.derivation_initial_def)
    apply(rename_tac G dh n sUF m e2 c2 e1 c1)(*strict*)
    apply(force)
   apply(rename_tac G dh n sUF m e2 c2 e1 c1)(*strict*)
   apply(force)
  apply(rename_tac G dh n sUF m e2 c2 e1 c1)(*strict*)
  apply(clarsimp)
  apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c)(*strict*)
  apply(simp add: get_configuration_def epdaS_get_scheduler_def)
  apply(subgoal_tac "Suc m\<le>n")
   apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c)(*strict*)
   prefer 2
   apply(rule epdaS.allPreMaxDomSome_prime)
     apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c)(*strict*)
     apply(force)
    apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c)(*strict*)
    apply(force)
   apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c)(*strict*)
   apply(force)
  apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c)(*strict*)
  apply(subgoal_tac "\<exists>w. epdaS_string_state c1 = w @ epdaS_string_state c")
   apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c)(*strict*)
   prefer 2
   apply(rule_tac
      j="n-m"
      in epdaS.derivation_monotonically_dec)
        apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c)(*strict*)
        apply(force)
       apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c)(*strict*)
       apply(force)
      apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c)(*strict*)
      apply(force)
     apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c)(*strict*)
     apply(force)
    apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c)(*strict*)
    apply(force)
   apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c)(*strict*)
   apply(force)
  apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c)(*strict*)
  apply(clarsimp)
  apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c w)(*strict*)
  apply(simp add: epdaS_string_state_def)
  apply(subgoal_tac "\<exists>w. epdaS_string_state c2 = w @ epdaS_string_state c")
   apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c w)(*strict*)
   prefer 2
   apply(rule_tac
      j="n-Suc m"
      in epdaS.derivation_monotonically_dec)
        apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c w)(*strict*)
        apply(force)
       apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c w)(*strict*)
       apply(force)
      apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c w)(*strict*)
      apply(force)
     apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c w)(*strict*)
     apply(force)
    apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c w)(*strict*)
    apply(force)
   apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c w)(*strict*)
   apply(force)
  apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c w)(*strict*)
  apply(clarsimp)
  apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c w wa)(*strict*)
  apply(simp add: epdaS_string_state_def)
  apply(rule_tac
      t="right_quotient_word (w @ epdaHS_conf_scheduler c) (epdaHS_conf_scheduler c)"
      and s="Some w"
      in ssubst)
   apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c w wa)(*strict*)
   apply(rule right_quotient_word_Some_by_append)
   apply(force)
  apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c w wa)(*strict*)
  apply(rule_tac
      t="right_quotient_word (wa @ epdaHS_conf_scheduler c) (epdaHS_conf_scheduler c)"
      and s="Some wa"
      in ssubst)
   apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c w wa)(*strict*)
   apply(rule right_quotient_word_Some_by_append)
   apply(force)
  apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c w wa)(*strict*)
  apply(simp add: epdaS_step_relation_def)
  apply(clarsimp)
  apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c wa wb)(*strict*)
  apply(rule_tac
      t="right_quotient_word (option_to_list (edge_event e2) @ wa @ epdaS_conf_scheduler c) (epdaS_conf_scheduler c)"
      and s="Some (option_to_list (edge_event e2) @ wa)"
      in ssubst)
   apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c wa wb)(*strict*)
   apply(rule right_quotient_word_Some_by_append)
   apply(force)
  apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c wa wb)(*strict*)
  apply(clarsimp)
  apply(rule sym)
  apply(rule_tac
      t="right_quotient_word (wa @ epdaS_conf_scheduler c) (epdaS_conf_scheduler c)"
      and s="Some wa"
      in ssubst)
   apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c wa wb)(*strict*)
   apply(rule right_quotient_word_Some_by_append)
   apply(force)
  apply(rename_tac G dh n sUF m e2 c2 e1 c1 e c wa wb)(*strict*)
  apply(force)
  done

lemma epdaS_inst_ATS_Sched_DB0_axioms: "
  ATS_Sched_DB0_axioms valid_epda epdaS_configurations
     epdaS_initial_configurations epda_step_labels epdaS_step_relation
     epda_fixed_scheduler_extendable epda_effects right_quotient_word (@)
     epda_unfixed_scheduler_extendable epda_effects epdaS_get_scheduler (@)
     epdaS_set_unfixed_scheduler_DB epdaS_get_unfixed_scheduler_DB
     epdaS_get_fixed_scheduler_DB"
  apply(simp add: ATS_Sched_DB0_axioms_def)
  apply(rule conjI)
   apply(simp add: epdaS_inst_AX_join_fixed_scheduler_unfixed_scheduler_closed_prime )
  apply(rule conjI)
   apply(simp add: epdaS_inst_AX_get_fixed_scheduler_DB_and_get_unfixed_scheduler_DB_vs_get_scheduler_nth )
  apply(rule epdaS_inst_AX_sched_modification_preserves_steps)
  done

interpretation "epdaS" : loc_autS_3
  (* TSstructure *)
  "valid_epda"
  (* configurations *)
  "epdaS_configurations"
  (* initial_configurations *)
  "epdaS_initial_configurations"
  (* step_labels *)
  "epda_step_labels"
  (* step_relation *)
  "epdaS_step_relation"
  (* effects *)
  "epda_effects"
  (* marking_condition *)
  "epdaS_marking_condition"
  (* marked_effect *)
  "epdaS_marked_effect"
  (* unmarked_effect *)
  "epdaS_unmarked_effect"
  (* destinations *)
  "epda_destinations"
  (* get_destinations *)
  "epdaS_get_destinations"
  (* decreasing *)
  "True"
  (* string_state *)
  "epdaS_string_state"
  (* fixed_schedulers *)
  epda_fixed_schedulers
  (* empty_fixed_scheduler *)
  epda_empty_fixed_scheduler
  (* fixed_scheduler_extendable *)
  epda_fixed_scheduler_extendable
  (* scheduler_fragments *)
  "epda_effects"
  (* empty_scheduler_fragment *)
  epda_empty_scheduler_fragment
  (* join_scheduler_fragments *)
  "append"
  (* unfixed_schedulers *)
  "epda_effects"
  (* empty_unfixed_scheduler *)
  epda_empty_unfixed_scheduler
  (* unfixed_scheduler_right_quotient_word *)
  "right_quotient_word"
  (* extend_unfixed_scheduler *)
  "append"
  (* unfixed_scheduler_extendable *)
  epda_unfixed_scheduler_extendable
  (* schedulers *)
  "epda_effects"
  (* initial_schedulers *)
  "epda_effects"
  (* empty_scheduler *)
  epda_empty_scheduler
  (* get_scheduler *)
  "epdaS_get_scheduler"
  (* join_fixed_scheduler_unfixed_scheduler *)
  "append"
  (* extend_scheduler *)
  "append"
  (* set_unfixed_scheduler_DB *)
  "epdaS_set_unfixed_scheduler_DB"
  (* get_unfixed_scheduler_DB *)
  "epdaS_get_unfixed_scheduler_DB"
  (* get_fixed_scheduler_DB *)
  "epdaS_get_fixed_scheduler_DB"
  apply(simp add: LOCALE_DEFS)
  apply(simp add: epdaS_inst_AX_initial_configuration_belongs epdaS_inst_AX_step_relation_preserves_belongs )
  apply(simp add: epdaS_inst_ATS_Language_by_Finite_Derivations_axioms epdaS_inst_ATS_String_State_Modification_axioms epdaS_inst_ATS_Language_axioms )
  apply(simp add: epdaS_inst_ATS_Sched_Basic_axioms epdaS_inst_ATS_Scheduler_Fragment_axioms epdaS_inst_ATS_SchedUF_Basic_axioms epdaS_inst_ATS_SchedUF_DB_axioms epdaS_inst_ATS_SchedF_Basic_axioms epdaS_inst_ATS_SchedF_DB_axioms epdaS_inst_ATS_Sched_axioms )
  apply(simp add: epdaS_inst_ATS_Sched_DB0_axioms )
  done

lemma epdaS_inst_AX_replace_unfixed_scheduler_DB_sound: "
  \<forall>G. valid_epda G \<longrightarrow> (\<forall>d n. maximum_of_domain d n \<longrightarrow> epdaS.derivation_initial G d \<longrightarrow> (\<forall>sUF. sUF \<in> epda_effects G \<longrightarrow> epdaS_get_unfixed_scheduler_DB G (ATS_SchedUF_DB.replace_unfixed_scheduler_DB right_quotient_word (@) epdaS_set_unfixed_scheduler_DB epdaS_get_unfixed_scheduler_DB G d sUF n) n = sUF))"
  apply(clarsimp)
  apply(rename_tac G d n sUF)(*strict*)
  apply(simp add: epdaS_get_unfixed_scheduler_DB_def)
  apply(subgoal_tac "\<exists>e c. d n = Some (pair e c)")
   apply(rename_tac G d n sUF)(*strict*)
   prefer 2
   apply(rule epdaS.some_position_has_details_before_max_dom)
     apply(rename_tac G d n sUF)(*strict*)
     apply(simp add: epdaS.derivation_initial_def)
     apply(force)
    apply(rename_tac G d n sUF)(*strict*)
    apply(force)
   apply(rename_tac G d n sUF)(*strict*)
   apply(force)
  apply(rename_tac G d n sUF)(*strict*)
  apply(clarsimp)
  apply(rename_tac G d n sUF e c)(*strict*)
  apply(simp add: epdaS.replace_unfixed_scheduler_DB_def epdaS.map_unfixed_scheduler_DB_def)
  apply(rule_tac
      t="right_quotient_word (epdaS_get_unfixed_scheduler_DB G d n) (epdaS_get_unfixed_scheduler_DB G d n)"
      and s="Some []"
      in ssubst)
   apply(rename_tac G d n sUF e c)(*strict*)
   apply (metis right_quotient_word_full)
  apply(rename_tac G d n sUF e c)(*strict*)
  apply(clarsimp)
  apply(simp add: epdaS_set_unfixed_scheduler_DB_def get_configuration_def epdaS_get_scheduler_def)
  done

lemma epdaS_inst_ATS_Sched_DB_axioms: "
  ATS_Sched_DB_axioms valid_epda epdaS_initial_configurations
     epdaS_step_relation epda_effects right_quotient_word (@)
     epda_unfixed_scheduler_extendable epdaS_set_unfixed_scheduler_DB
     epdaS_get_unfixed_scheduler_DB"
  apply(simp add: ATS_Sched_DB_axioms_def)
  apply(rule epdaS_inst_AX_replace_unfixed_scheduler_DB_sound)
  done

interpretation "epdaS" : loc_autS_4
  (* TSstructure *)
  "valid_epda"
  (* configurations *)
  "epdaS_configurations"
  (* initial_configurations *)
  "epdaS_initial_configurations"
  (* step_labels *)
  "epda_step_labels"
  (* step_relation *)
  "epdaS_step_relation"
  (* effects *)
  "epda_effects"
  (* marking_condition *)
  "epdaS_marking_condition"
  (* marked_effect *)
  "epdaS_marked_effect"
  (* unmarked_effect *)
  "epdaS_unmarked_effect"
  (* destinations *)
  "epda_destinations"
  (* get_destinations *)
  "epdaS_get_destinations"
  (* decreasing *)
  "True"
  (* string_state *)
  "epdaS_string_state"
  (* fixed_schedulers *)
  epda_fixed_schedulers
  (* empty_fixed_scheduler *)
  epda_empty_fixed_scheduler
  (* fixed_scheduler_extendable *)
  epda_fixed_scheduler_extendable
  (* scheduler_fragments *)
  "epda_effects"
  (* empty_scheduler_fragment *)
  epda_empty_scheduler_fragment
  (* join_scheduler_fragments *)
  "append"
  (* unfixed_schedulers *)
  "epda_effects"
  (* empty_unfixed_scheduler *)
  epda_empty_unfixed_scheduler
  (* unfixed_scheduler_right_quotient_word *)
  "right_quotient_word"
  (* extend_unfixed_scheduler *)
  "append"
  (* unfixed_scheduler_extendable *)
  epda_unfixed_scheduler_extendable
  (* schedulers *)
  "epda_effects"
  (* initial_schedulers *)
  "epda_effects"
  (* empty_scheduler *)
  epda_empty_scheduler
  (* get_scheduler *)
  "epdaS_get_scheduler"
  (* join_fixed_scheduler_unfixed_scheduler *)
  "append"
  (* extend_scheduler *)
  "append"
  (* set_unfixed_scheduler_DB *)
  "epdaS_set_unfixed_scheduler_DB"
  (* get_unfixed_scheduler_DB *)
  "epdaS_get_unfixed_scheduler_DB"
  (* get_fixed_scheduler_DB *)
  "epdaS_get_fixed_scheduler_DB"
  apply(simp add: LOCALE_DEFS)
  apply(simp add: epdaS_inst_AX_initial_configuration_belongs epdaS_inst_AX_step_relation_preserves_belongs epdaS_inst_ATS_Language_by_Finite_Derivations_axioms epdaS_inst_ATS_String_State_Modification_axioms epdaS_inst_ATS_Language_axioms epdaS_inst_ATS_Sched_Basic_axioms epdaS_inst_ATS_Scheduler_Fragment_axioms epdaS_inst_ATS_SchedUF_Basic_axioms epdaS_inst_ATS_SchedUF_DB_axioms epdaS_inst_ATS_SchedF_Basic_axioms epdaS_inst_ATS_SchedF_DB_axioms epdaS_inst_ATS_Sched_axioms epdaS_inst_ATS_Sched_DB0_axioms epdaS_inst_ATS_Sched_DB_axioms )
  done

lemma epdaS_step_exists: "
  valid_epda G
  \<Longrightarrow> c \<in> epdaS_configurations G
  \<Longrightarrow> e \<in> epda_delta G
  \<Longrightarrow> epdaS_conf_state c = edge_src e
  \<Longrightarrow> prefix (option_to_list (edge_event e)) (epdaS_conf_scheduler c)
  \<Longrightarrow> prefix (edge_pop e) (epdaS_conf_stack c)
  \<Longrightarrow> \<exists>c'. epdaS_step_relation G c e c'"
  apply(rule_tac
      x="\<lparr>epdaS_conf_state=SSq,epdaS_conf_scheduler=drop(length(option_to_list (edge_event e)))(epdaS_conf_scheduler c),epdaS_conf_stack=(edge_push e)@drop(length(edge_pop e))(epdaS_conf_stack c)\<rparr>" for SSq
      in exI)
  apply(simp add: epdaS_step_relation_def)
  apply(rule conjI)
   apply(force)
  apply(rule conjI)
   apply(simp add: option_to_list_def)
   apply(case_tac "edge_event e")
    apply(clarsimp)
   apply(rename_tac a)(*strict*)
   apply(clarsimp)
   apply(simp add: prefix_def)
   apply(clarsimp)
   apply(rename_tac a ca caa)(*strict*)
   apply (metis drop1)
  apply(simp add: prefix_def)
  apply(clarsimp)
  apply(rename_tac ca caa)(*strict*)
  apply (metis append_eq_conv_conj)
  done

lemmas epdaS_interpretations =
  epdaS_inst_AX_initial_configuration_belongs
  epdaS_inst_AX_step_relation_preserves_belongs
  epdaS_inst_ATS_Language_by_Finite_Derivations_axioms
  epdaS_inst_ATS_String_State_Modification_axioms
  epdaS_inst_ATS_Language_axioms
  epdaS_inst_ATS_Sched_Basic_axioms
  epdaS_inst_ATS_Scheduler_Fragment_axioms
  epdaS_inst_ATS_SchedUF_Basic_axioms
  epdaS_inst_ATS_SchedUF_DB_axioms
  epdaS_inst_ATS_SchedF_Basic_axioms
  epdaS_inst_ATS_SchedF_DB_axioms
  epdaS_inst_ATS_Sched_axioms
  epdaS_inst_ATS_Sched_DB0_axioms
  epdaS_inst_ATS_Sched_DB_axioms

lemma valid_epda_preserves_box_at_end: "
  valid_epda G
  \<Longrightarrow> epdaS.derivation_initial G d
  \<Longrightarrow> d n = Some (pair e c)
  \<Longrightarrow> \<exists>w. epdaS_conf_stack c = w @ [epda_box G]"
  apply(induct n arbitrary: e c)
   apply(rename_tac e c)(*strict*)
   apply(simp add: epdaS.derivation_initial_def epdaS_initial_configurations_def)
  apply(rename_tac n e c)(*strict*)
  apply(clarsimp)
  apply(subgoal_tac "\<exists>e1 e2 c1 c2. d n = Some (pair e1 c1) \<and> d (Suc n) = Some (pair (Some e2) c2) \<and> epdaS_step_relation G c1 e2 c2")
   apply(rename_tac n e c)(*strict*)
   prefer 2
   apply(rule_tac
      m="Suc n"
      in epdaS.step_detail_before_some_position)
     apply(rename_tac n e c)(*strict*)
     apply(simp add: epdaS.derivation_initial_def)
    apply(rename_tac n e c)(*strict*)
    apply(force)
   apply(rename_tac n e c)(*strict*)
   apply(force)
  apply(rename_tac n e c)(*strict*)
  apply(clarsimp)
  apply(rename_tac n c e1 e2 c1)(*strict*)
  apply(erule_tac
      x="e1"
      in meta_allE)
  apply(erule_tac
      x="c1"
      in meta_allE)
  apply(clarsimp)
  apply(rename_tac n c e1 e2 c1 w)(*strict*)
  apply(simp add: epdaS_step_relation_def)
  apply(clarsimp)
  apply(rename_tac n c e1 e2 c1 w wa)(*strict*)
  apply(subgoal_tac "valid_epda_step_label G e2")
   apply(rename_tac n c e1 e2 c1 w wa)(*strict*)
   apply(simp add: valid_epda_step_label_def)
   apply(clarsimp)
   apply(subgoal_tac "prefix w (edge_pop e2) \<or> prefix (edge_pop e2) w")
    apply(rename_tac n c e1 e2 c1 w wa)(*strict*)
    prefer 2
    apply(rule mutual_prefix_prefix)
    apply(force)
   apply(rename_tac n c e1 e2 c1 w wa)(*strict*)
   apply(erule disjE)
    apply(rename_tac n c e1 e2 c1 w wa)(*strict*)
    apply(simp add: prefix_def)
    apply(clarsimp)
    apply(rename_tac n c e1 e2 c1 w wa ca)(*strict*)
    apply(case_tac e2)
    apply(rename_tac n c e1 e2 c1 w wa ca edge_srca edge_eventa edge_popa edge_pusha edge_trga)(*strict*)
    apply(clarsimp)
    apply(rename_tac n c e1 c1 w wa ca edge_event edge_push)(*strict*)
    apply(case_tac ca)
     apply(rename_tac n c e1 c1 w wa ca edge_event edge_push)(*strict*)
     apply(clarsimp)
    apply(rename_tac n c e1 c1 w wa ca edge_event edge_push a list)(*strict*)
    apply(clarsimp)
    apply(rename_tac n c e1 c1 w edge_event)(*strict*)
    apply(simp add: must_terminated_by_def may_terminated_by_def append_language_def kleene_star_def)
    apply(clarsimp)
    apply(rename_tac n c e1 c1 w edge_event a aa)(*strict*)
    apply(erule_tac
      P="epdaS_conf_stack c = aa @ [epda_box G]"
      in disjE)
     apply(rename_tac n c e1 c1 w edge_event a aa)(*strict*)
     apply(clarsimp)
    apply(rename_tac n c e1 c1 w edge_event a aa)(*strict*)
    apply(clarsimp)
    apply(rename_tac n c e1 c1 w edge_event a)(*strict*)
    apply(erule disjE)
     apply(rename_tac n c e1 c1 w edge_event a)(*strict*)
     apply(clarsimp)
    apply(rename_tac n c e1 c1 w edge_event a)(*strict*)
    apply(clarsimp)
    apply(rename_tac n c e1 c1 w edge_event)(*strict*)
    apply(case_tac c)
    apply(rename_tac n c e1 c1 w edge_event epdaS_conf_statea epdaS_conf_schedulera epdaS_conf_stacka)(*strict*)
    apply(case_tac c1)
    apply(rename_tac n c e1 c1 w edge_event epdaS_conf_statea epdaS_conf_schedulera epdaS_conf_stacka epdaS_conf_stateaa epdaS_conf_scheduleraa epdaS_conf_stackaa)(*strict*)
    apply(clarsimp)
   apply(rename_tac n c e1 e2 c1 w wa)(*strict*)
   apply(simp add: prefix_def)
   apply(clarsimp)
  apply(rename_tac n c e1 e2 c1 w wa)(*strict*)
  apply(simp add: valid_epda_def)
  done

definition epdaS_produce_from_before_pop :: "
  ('state, 'event, 'stack) epda
  \<Rightarrow> 'state
  \<Rightarrow> 'stack
  \<Rightarrow> 'state
  \<Rightarrow> 'event list set"
  where
    "epdaS_produce_from_before_pop G qi A qt \<equiv>
  {w. \<exists>d q s.
    epdaS.derivation G d
    \<and> epdaS.belongs G d
    \<and> d 0 = Some (pair None
          \<lparr>epdaS_conf_state = qi,
          epdaS_conf_scheduler = w,
          epdaS_conf_stack = A # s\<rparr>)
    \<and> (\<exists>j e e'.
        d j = Some (pair e
            \<lparr>epdaS_conf_state = q,
            epdaS_conf_scheduler = [],
            epdaS_conf_stack = A # s\<rparr>)
        \<and> d (Suc j) = Some (pair e'
              \<lparr>epdaS_conf_state = qt,
              epdaS_conf_scheduler = [],
              epdaS_conf_stack = s\<rparr>)
        \<and> (\<forall>k \<le> j. \<forall>e c.
            d k = Some (pair e c)
            \<longrightarrow> (\<exists>w. epdaS_conf_stack c = w @ [A] @ s)))}"

lemma epdaS_produce_from_before_popCons: "
  valid_epda G
  \<Longrightarrow> \<lparr>edge_src = src, edge_event = Some a, edge_pop = [A], edge_push = [A], edge_trg = trg\<rparr> \<in> epda_delta G
  \<Longrightarrow> w \<in> epdaS_produce_from_before_pop G trg A q
  \<Longrightarrow> a # w \<in> epdaS_produce_from_before_pop G src A q"
  apply(simp add: epdaS_produce_from_before_pop_def)
  apply(clarsimp)
  apply(rename_tac d qa s j e e')(*strict*)
  apply(rule_tac
      x="derivation_append (der2 \<lparr>epdaS_conf_state = src, epdaS_conf_scheduler = a # w, epdaS_conf_stack = A # s\<rparr> \<lparr>edge_src = src, edge_event = Some a, edge_pop = [A], edge_push = [A], edge_trg = trg\<rparr> \<lparr>epdaS_conf_state = trg, epdaS_conf_scheduler = w, epdaS_conf_stack = A # s\<rparr>) d (Suc 0)"
      in exI)
  apply(rename_tac d qa s j e e')(*strict*)
  apply(rule context_conjI)
   apply(rename_tac d qa s j e e')(*strict*)
   apply(rule epdaS.derivation_append_preserves_derivation)
     apply(rename_tac d qa s j e e')(*strict*)
     apply(rule epdaS.der2_is_derivation)
     apply(simp add: epdaS_step_relation_def)
     apply(simp add: option_to_list_def)
    apply(rename_tac d qa s j e e')(*strict*)
    apply(force)
   apply(rename_tac d qa s j e e')(*strict*)
   apply(simp add: der2_def)
  apply(rename_tac d qa s j e e')(*strict*)
  apply(rule conjI)
   apply(rename_tac d qa s j e e')(*strict*)
   apply(rule epdaS.derivation_append_preserves_belongs)
     apply(rename_tac d qa s j e e')(*strict*)
     apply(force)
    apply(rename_tac d qa s j e e')(*strict*)
    apply(rule epdaS.der2_belongs)
      apply(rename_tac d qa s j e e')(*strict*)
      apply(subgoal_tac "\<lparr>epdaS_conf_state = trg, epdaS_conf_scheduler = w, epdaS_conf_stack = A # s\<rparr> \<in> epdaS_configurations G")
       apply(rename_tac d qa s j e e')(*strict*)
       apply(simp add: epdaS_configurations_def)
       apply(subgoal_tac "valid_epda_step_label G \<lparr>edge_src = src, edge_event = Some a, edge_pop = [A], edge_push = [A], edge_trg = trg\<rparr>")
        apply(rename_tac d qa s j e e')(*strict*)
        apply(simp add: valid_epda_step_label_def)
        apply(clarsimp)
        apply(simp add: option_to_set_def)
       apply(rename_tac d qa s j e e')(*strict*)
       apply(simp add: valid_epda_def)
      apply(rename_tac d qa s j e e')(*strict*)
      apply(rule epdaS.belongs_configurations)
       apply(rename_tac d qa s j e e')(*strict*)
       apply(force)
      apply(rename_tac d qa s j e e')(*strict*)
      apply(force)
     apply(rename_tac d qa s j e e')(*strict*)
     apply(simp add: epda_step_labels_def)
    apply(rename_tac d qa s j e e')(*strict*)
    apply(rule epdaS.belongs_configurations)
     apply(rename_tac d qa s j e e')(*strict*)
     apply(force)
    apply(rename_tac d qa s j e e')(*strict*)
    apply(force)
   apply(rename_tac d qa s j e e')(*strict*)
   apply(force)
  apply(rename_tac d qa s j e e')(*strict*)
  apply(rule_tac
      x="qa"
      in exI)
  apply(rule_tac
      x="s"
      in exI)
  apply(rule conjI)
   apply(rename_tac d qa s j e e')(*strict*)
   apply(simp add: derivation_append_def der2_def)
  apply(rename_tac d qa s j e e')(*strict*)
  apply(rule_tac
      x="Suc j"
      in exI)
  apply(rule conjI)
   apply(rename_tac d qa s j e e')(*strict*)
   apply(simp add: derivation_append_def der2_def)
   apply(clarsimp)
  apply(rename_tac d qa s j e e')(*strict*)
  apply(rule conjI)
   apply(rename_tac d qa s j e e')(*strict*)
   apply(simp add: derivation_append_def der2_def)
  apply(rename_tac d qa s j e e')(*strict*)
  apply(clarsimp)
  apply(rename_tac d qa s j e e' k ea c)(*strict*)
  apply(simp add: derivation_append_def der2_def)
  apply(case_tac k)
   apply(rename_tac d qa s j e e' k ea c)(*strict*)
   apply(force)
  apply(rename_tac d qa s j e e' k ea c nat)(*strict*)
  apply(clarsimp)
  apply(rename_tac d qa s j e e' ea c nat)(*strict*)
  apply(erule_tac
      x="nat"
      in allE)
  apply(clarsimp)
  apply(case_tac "nat")
   apply(rename_tac d qa s j e e' ea c nat)(*strict*)
   apply(clarsimp)
  apply(rename_tac d qa s j e e' ea c nat nata)(*strict*)
  apply(clarsimp)
  done

definition epdaS_required_edges :: "
  ('state, 'event, 'stack)epda
  \<Rightarrow> ('state, 'event, 'stack) epda_step_label set"
  where
    "epdaS_required_edges G \<equiv>
  {e \<in> epda_delta G.
    \<exists>d n c.
      epdaS.derivation_initial G d
      \<and> d n = Some (pair (Some e) c)
      \<and> (\<exists>k\<ge>n. \<exists>e c.
          d k = Some (pair e c)
          \<and> c \<in> epdaS_marking_configurations G)}"

lemma epdaS_is_forward_target_deterministic_accessible: "
  epdaS.is_forward_target_deterministic_accessible G"
  apply(simp add: epdaS.is_forward_target_deterministic_accessible_def)
  apply(clarsimp)
  apply(simp add: epdaS_step_relation_def)
  apply(clarsimp)
  done

end


(*  Title:      ZF/UNITY/Merge.thy
    Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
    Copyright   2002  University of Cambridge

A multiple-client allocator from a single-client allocator: Merge
specification.
*)

theory Merge imports AllocBase Follows  Guar GenPrefix begin

(** Merge specification (the number of inputs is Nclients) ***)
(** Parameter A represents the type of items to Merge **)

definition
  (*spec (10)*)
  merge_increasing :: "[i, i, i] =>i"  where
    "merge_increasing(A, Out, iOut) == program guarantees
         (lift(Out) IncreasingWrt  prefix(A)/list(A)) Int
         (lift(iOut) IncreasingWrt prefix(nat)/list(nat))"

definition
  (*spec (11)*)
  merge_eq_Out :: "[i, i] =>i"  where
  "merge_eq_Out(Out, iOut) == program guarantees
         Always({s \<in> state. length(s`Out) = length(s`iOut)})"

definition
  (*spec (12)*)
  merge_bounded :: "i=>i"  where
  "merge_bounded(iOut) == program guarantees
         Always({s \<in> state. \<forall>elt \<in> set_of_list(s`iOut). elt<Nclients})"

definition
  (*spec (13)*)
  (* Parameter A represents the type of tokens *)
  merge_follows :: "[i, i=>i, i, i] =>i"  where
    "merge_follows(A, In, Out, iOut) ==
     (\<Inter>n \<in> Nclients. lift(In(n)) IncreasingWrt prefix(A)/list(A))
                   guarantees
     (\<Inter>n \<in> Nclients.
        (%s. sublist(s`Out, {k \<in> nat. k < length(s`iOut) &
                      nth(k, s`iOut) = n})) Fols lift(In(n))
         Wrt prefix(A)/list(A))"

definition
  (*spec: preserves part*)
  merge_preserves :: "[i=>i] =>i"  where
    "merge_preserves(In) == \<Inter>n \<in> nat. preserves(lift(In(n)))"

definition
(* environmental constraints*)
  merge_allowed_acts :: "[i, i] =>i"  where
  "merge_allowed_acts(Out, iOut) ==
         {F \<in> program. AllowedActs(F) =
            cons(id(state), (\<Union>G \<in> preserves(lift(Out)) \<inter>
                                   preserves(lift(iOut)). Acts(G)))}"

definition
  merge_spec :: "[i, i =>i, i, i]=>i"  where
  "merge_spec(A, In, Out, iOut) ==
   merge_increasing(A, Out, iOut) \<inter> merge_eq_Out(Out, iOut) \<inter>
   merge_bounded(iOut) \<inter>  merge_follows(A, In, Out, iOut)
   \<inter> merge_allowed_acts(Out, iOut) \<inter> merge_preserves(In)"

(** State definitions.  OUTPUT variables are locals **)
locale merge =
  fixes In   \<comment>\<open>merge's INPUT histories: streams to merge\<close>
    and Out  \<comment>\<open>merge's OUTPUT history: merged items\<close>
    and iOut \<comment>\<open>merge's OUTPUT history: origins of merged items\<close>
    and A    \<comment>\<open>the type of items being merged\<close>
    and M
 assumes var_assumes [simp]:
           "(\<forall>n. In(n):var) & Out \<in> var & iOut \<in> var"
     and all_distinct_vars:
           "\<forall>n. all_distinct([In(n), Out, iOut])"
     and type_assumes [simp]:
           "(\<forall>n. type_of(In(n))=list(A)) &
            type_of(Out)=list(A) &
            type_of(iOut)=list(nat)"
     and default_val_assumes [simp]:
           "(\<forall>n. default_val(In(n))=Nil) &
            default_val(Out)=Nil &
            default_val(iOut)=Nil"
     and merge_spec:  "M \<in> merge_spec(A, In, Out, iOut)"

lemma (in merge) In_value_type [TC,simp]: "s \<in> state ==> s`In(n) \<in> list(A)"
apply (unfold state_def)
apply (drule_tac a = "In (n)" in apply_type)
apply auto
done

lemma (in merge) Out_value_type [TC,simp]: "s \<in> state ==> s`Out \<in> list(A)"
apply (unfold state_def)
apply (drule_tac a = Out in apply_type, auto)
done

lemma (in merge) iOut_value_type [TC,simp]: "s \<in> state ==> s`iOut \<in> list(nat)"
apply (unfold state_def)
apply (drule_tac a = iOut in apply_type, auto)
done

lemma (in merge) M_in_program [intro,simp]: "M \<in> program"
apply (cut_tac merge_spec)
apply (auto dest: guarantees_type [THEN subsetD]
            simp add: merge_spec_def merge_increasing_def)
done

lemma (in merge) merge_Allowed:
     "Allowed(M) = (preserves(lift(Out)) \<inter> preserves(lift(iOut)))"
apply (insert merge_spec preserves_type [of "lift (Out)"])
apply (auto simp add: merge_spec_def merge_allowed_acts_def Allowed_def safety_prop_Acts_iff)
done

lemma (in merge) M_ok_iff:
     "G \<in> program ==>
       M ok G \<longleftrightarrow> (G \<in> preserves(lift(Out)) &
                   G \<in> preserves(lift(iOut)) & M \<in> Allowed(G))"
apply (cut_tac merge_spec)
apply (auto simp add: merge_Allowed ok_iff_Allowed)
done

lemma (in merge) merge_Always_Out_eq_iOut:
     "[| G \<in> preserves(lift(Out)); G \<in> preserves(lift(iOut));
         M \<in> Allowed(G) |]
      ==> M \<squnion> G \<in> Always({s \<in> state. length(s`Out)=length(s`iOut)})"
apply (frule preserves_type [THEN subsetD])
apply (subgoal_tac "G \<in> program")
 prefer 2 apply assumption
apply (frule M_ok_iff)
apply (cut_tac merge_spec)
apply (force dest: guaranteesD simp add: merge_spec_def merge_eq_Out_def)
done

lemma (in merge) merge_Bounded:
     "[| G \<in> preserves(lift(iOut)); G \<in> preserves(lift(Out));
         M \<in> Allowed(G) |] ==>
       M \<squnion> G: Always({s \<in> state. \<forall>elt \<in> set_of_list(s`iOut). elt<Nclients})"
apply (frule preserves_type [THEN subsetD])
apply (frule M_ok_iff)
apply (cut_tac merge_spec)
apply (force dest: guaranteesD simp add: merge_spec_def merge_bounded_def)
done

lemma (in merge) merge_bag_Follows_lemma:
"[| G \<in> preserves(lift(iOut));
    G: preserves(lift(Out)); M \<in> Allowed(G) |]
  ==> M \<squnion> G \<in> Always
    ({s \<in> state. msetsum(%i. bag_of(sublist(s`Out,
      {k \<in> nat. k < length(s`iOut) & nth(k, s`iOut)=i})),
                   Nclients, A) = bag_of(s`Out)})"
apply (rule Always_Diff_Un_eq [THEN iffD1])
apply (rule_tac [2] state_AlwaysI [THEN Always_weaken])
apply (rule Always_Int_I [OF merge_Always_Out_eq_iOut merge_Bounded], auto)
apply (subst bag_of_sublist_UN_disjoint [symmetric])
apply (auto simp add: nat_into_Finite set_of_list_conv_nth  [OF iOut_value_type])
apply (subgoal_tac " (\<Union>i \<in> Nclients. {k \<in> nat. k < length (x`iOut) & nth (k, x`iOut) = i}) = length (x`iOut) ")
apply (auto simp add: sublist_upt_eq_take [OF Out_value_type]
                      length_type  [OF iOut_value_type]
                      take_all [OF _ Out_value_type]
                      length_type [OF iOut_value_type])
apply (rule equalityI)
apply (blast dest: ltD, clarify)
apply (subgoal_tac "length (x ` iOut) \<in> nat")
 prefer 2 apply (simp add: length_type [OF iOut_value_type])
apply (subgoal_tac "xa \<in> nat")
apply (simp_all add: Ord_mem_iff_lt)
prefer 2 apply (blast intro: lt_trans)
apply (drule_tac x = "nth (xa, x`iOut)" and P = "%elt. X (elt) \<longrightarrow> elt<Nclients" for X in bspec)
apply (simp add: ltI nat_into_Ord)
apply (blast dest: ltD)
done

theorem (in merge) merge_bag_Follows:
    "M \<in> (\<Inter>n \<in> Nclients. lift(In(n)) IncreasingWrt prefix(A)/list(A))
            guarantees
      (%s. bag_of(s`Out)) Fols
      (%s. msetsum(%i. bag_of(s`In(i)),Nclients, A)) Wrt MultLe(A, r)/Mult(A)"
apply (cut_tac merge_spec)
apply (rule merge_bag_Follows_lemma [THEN Always_Follows1, THEN guaranteesI])
     apply (simp_all add: M_ok_iff, clarify)
apply (rule Follows_state_ofD1 [OF Follows_msetsum_UN])
   apply (simp_all add: nat_into_Finite bag_of_multiset [of _ A])
apply (simp add: INT_iff merge_spec_def merge_follows_def, clarify)
apply (cut_tac merge_spec)
apply (subgoal_tac "M ok G")
 prefer 2 apply (force intro: M_ok_iff [THEN iffD2])
apply (drule guaranteesD, assumption)
  apply (simp add: merge_spec_def merge_follows_def, blast)
apply (simp cong add: Follows_cong
            add: refl_prefix
               mono_bag_of [THEN subset_Follows_comp, THEN subsetD,
                            unfolded metacomp_def])
done

end


(*  Title:      HOL/Auth/NS_Shared.thy
    Author:     Lawrence C Paulson and Giampaolo Bella
    Copyright   1996  University of Cambridge
*)

section{*Needham-Schroeder Shared-Key Protocol and the Issues Property*}

theory NS_Shared imports Public begin

text{*
From page 247 of
  Burrows, Abadi and Needham (1989).  A Logic of Authentication.
  Proc. Royal Soc. 426
*}

definition
 (* A is the true creator of X if she has sent X and X never appeared on
    the trace before this event. Recall that traces grow from head. *)
  Issues :: "[agent, agent, msg, event list] => bool"
             ("_ Issues _ with _ on _") where
   "A Issues B with X on evs =
      (\<exists>Y. Says A B Y \<in> set evs & X \<in> parts {Y} &
        X \<notin> parts (spies (takeWhile (% z. z  \<noteq> Says A B Y) (rev evs))))"

inductive_set ns_shared :: "event list set"
 where
        (*Initial trace is empty*)
  Nil:  "[] \<in> ns_shared"
        (*The spy MAY say anything he CAN say.  We do not expect him to
          invent new nonces here, but he can also use NS1.  Common to
          all similar protocols.*)
| Fake: "\<lbrakk>evsf \<in> ns_shared;  X \<in> synth (analz (spies evsf))\<rbrakk>
         \<Longrightarrow> Says Spy B X # evsf \<in> ns_shared"

        (*Alice initiates a protocol run, requesting to talk to any B*)
| NS1:  "\<lbrakk>evs1 \<in> ns_shared;  Nonce NA \<notin> used evs1\<rbrakk>
         \<Longrightarrow> Says A Server \<lbrace>Agent A, Agent B, Nonce NA\<rbrace> # evs1  \<in>  ns_shared"

        (*Server's response to Alice's message.
          !! It may respond more than once to A's request !!
          Server doesn't know who the true sender is, hence the A' in
              the sender field.*)
| NS2:  "\<lbrakk>evs2 \<in> ns_shared;  Key KAB \<notin> used evs2;  KAB \<in> symKeys;
          Says A' Server \<lbrace>Agent A, Agent B, Nonce NA\<rbrace> \<in> set evs2\<rbrakk>
         \<Longrightarrow> Says Server A
               (Crypt (shrK A)
                  \<lbrace>Nonce NA, Agent B, Key KAB,
                    (Crypt (shrK B) \<lbrace>Key KAB, Agent A\<rbrace>)\<rbrace>)
               # evs2 \<in> ns_shared"

         (*We can't assume S=Server.  Agent A "remembers" her nonce.
           Need A \<noteq> Server because we allow messages to self.*)
| NS3:  "\<lbrakk>evs3 \<in> ns_shared;  A \<noteq> Server;
          Says S A (Crypt (shrK A) \<lbrace>Nonce NA, Agent B, Key K, X\<rbrace>) \<in> set evs3;
          Says A Server \<lbrace>Agent A, Agent B, Nonce NA\<rbrace> \<in> set evs3\<rbrakk>
         \<Longrightarrow> Says A B X # evs3 \<in> ns_shared"

        (*Bob's nonce exchange.  He does not know who the message came
          from, but responds to A because she is mentioned inside.*)
| NS4:  "\<lbrakk>evs4 \<in> ns_shared;  Nonce NB \<notin> used evs4;  K \<in> symKeys;
          Says A' B (Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace>) \<in> set evs4\<rbrakk>
         \<Longrightarrow> Says B A (Crypt K (Nonce NB)) # evs4 \<in> ns_shared"

        (*Alice responds with Nonce NB if she has seen the key before.
          Maybe should somehow check Nonce NA again.
          We do NOT send NB-1 or similar as the Spy cannot spoof such things.
          Letting the Spy add or subtract 1 lets him send all nonces.
          Instead we distinguish the messages by sending the nonce twice.*)
| NS5:  "\<lbrakk>evs5 \<in> ns_shared;  K \<in> symKeys;
          Says B' A (Crypt K (Nonce NB)) \<in> set evs5;
          Says S  A (Crypt (shrK A) \<lbrace>Nonce NA, Agent B, Key K, X\<rbrace>)
            \<in> set evs5\<rbrakk>
         \<Longrightarrow> Says A B (Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace>) # evs5 \<in> ns_shared"

        (*This message models possible leaks of session keys.
          The two Nonces identify the protocol run: the rule insists upon
          the true senders in order to make them accurate.*)
| Oops: "\<lbrakk>evso \<in> ns_shared;  Says B A (Crypt K (Nonce NB)) \<in> set evso;
          Says Server A (Crypt (shrK A) \<lbrace>Nonce NA, Agent B, Key K, X\<rbrace>)
              \<in> set evso\<rbrakk>
         \<Longrightarrow> Notes Spy \<lbrace>Nonce NA, Nonce NB, Key K\<rbrace> # evso \<in> ns_shared"

declare Says_imp_knows_Spy [THEN parts.Inj, dest]
declare parts.Body  [dest]
declare Fake_parts_insert_in_Un  [dest]
declare analz_into_parts [dest]

text{*A "possibility property": there are traces that reach the end*}
lemma "[| A \<noteq> Server; Key K \<notin> used []; K \<in> symKeys |]
       ==> \<exists>N. \<exists>evs \<in> ns_shared.
                    Says A B (Crypt K \<lbrace>Nonce N, Nonce N\<rbrace>) \<in> set evs"
apply (intro exI bexI)
apply (rule_tac [2] ns_shared.Nil
       [THEN ns_shared.NS1, THEN ns_shared.NS2, THEN ns_shared.NS3,
        THEN ns_shared.NS4, THEN ns_shared.NS5])
apply (possibility, simp add: used_Cons)
done

(*This version is similar, while instantiating ?K and ?N to epsilon-terms
lemma "A \<noteq> Server \<Longrightarrow> \<exists>evs \<in> ns_shared.
                Says A B (Crypt ?K \<lbrace>Nonce ?N, Nonce ?N\<rbrace>) \<in> set evs"
*)

subsection{*Inductive proofs about @{term ns_shared}*}

subsubsection{*Forwarding lemmas, to aid simplification*}

text{*For reasoning about the encrypted portion of message NS3*}
lemma NS3_msg_in_parts_spies:
     "Says S A (Crypt KA \<lbrace>N, B, K, X\<rbrace>) \<in> set evs \<Longrightarrow> X \<in> parts (spies evs)"
by blast

text{*For reasoning about the Oops message*}
lemma Oops_parts_spies:
     "Says Server A (Crypt (shrK A) \<lbrace>NA, B, K, X\<rbrace>) \<in> set evs
            \<Longrightarrow> K \<in> parts (spies evs)"
by blast

text{*Theorems of the form @{term "X \<notin> parts (spies evs)"} imply that NOBODY
    sends messages containing @{term X}*}

text{*Spy never sees another agent's shared key! (unless it's bad at start)*}
lemma Spy_see_shrK [simp]:
     "evs \<in> ns_shared \<Longrightarrow> (Key (shrK A) \<in> parts (spies evs)) = (A \<in> bad)"
apply (erule ns_shared.induct, force, drule_tac [4] NS3_msg_in_parts_spies, simp_all, blast+)
done

lemma Spy_analz_shrK [simp]:
     "evs \<in> ns_shared \<Longrightarrow> (Key (shrK A) \<in> analz (spies evs)) = (A \<in> bad)"
by auto

text{*Nobody can have used non-existent keys!*}
lemma new_keys_not_used [simp]:
    "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> ns_shared|]
     ==> K \<notin> keysFor (parts (spies evs))"
apply (erule rev_mp)
apply (erule ns_shared.induct, force, drule_tac [4] NS3_msg_in_parts_spies, simp_all)
txt{*Fake, NS2, NS4, NS5*}
apply (force dest!: keysFor_parts_insert, blast+)
done

subsubsection{*Lemmas concerning the form of items passed in messages*}

text{*Describes the form of K, X and K' when the Server sends this message.*}
lemma Says_Server_message_form:
     "\<lbrakk>Says Server A (Crypt K' \<lbrace>N, Agent B, Key K, X\<rbrace>) \<in> set evs;
       evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> K \<notin> range shrK \<and>
          X = (Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace>) \<and>
          K' = shrK A"
by (erule rev_mp, erule ns_shared.induct, auto)

text{*If the encrypted message appears then it originated with the Server*}
lemma A_trusts_NS2:
     "\<lbrakk>Crypt (shrK A) \<lbrace>NA, Agent B, Key K, X\<rbrace> \<in> parts (spies evs);
       A \<notin> bad;  evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> Says Server A (Crypt (shrK A) \<lbrace>NA, Agent B, Key K, X\<rbrace>) \<in> set evs"
apply (erule rev_mp)
apply (erule ns_shared.induct, force, drule_tac [4] NS3_msg_in_parts_spies, auto)
done

lemma cert_A_form:
     "\<lbrakk>Crypt (shrK A) \<lbrace>NA, Agent B, Key K, X\<rbrace> \<in> parts (spies evs);
       A \<notin> bad;  evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> K \<notin> range shrK \<and>  X = (Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace>)"
by (blast dest!: A_trusts_NS2 Says_Server_message_form)

text{*EITHER describes the form of X when the following message is sent,
  OR     reduces it to the Fake case.
  Use @{text Says_Server_message_form} if applicable.*}
lemma Says_S_message_form:
     "\<lbrakk>Says S A (Crypt (shrK A) \<lbrace>Nonce NA, Agent B, Key K, X\<rbrace>) \<in> set evs;
       evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> (K \<notin> range shrK \<and> X = (Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace>))
          \<or> X \<in> analz (spies evs)"
by (blast dest: Says_imp_knows_Spy analz_shrK_Decrypt cert_A_form analz.Inj)

(*Alternative version also provable
lemma Says_S_message_form2:
  "\<lbrakk>Says S A (Crypt (shrK A) \<lbrace>Nonce NA, Agent B, Key K, X\<rbrace>) \<in> set evs;
    evs \<in> ns_shared\<rbrakk>
   \<Longrightarrow> Says Server A (Crypt (shrK A) \<lbrace>Nonce NA, Agent B, Key K, X\<rbrace>) \<in> set evs
       \<or> X \<in> analz (spies evs)"
apply (case_tac "A \<in> bad")
apply (force dest!: Says_imp_knows_Spy [THEN analz.Inj])
by (blast dest!: A_trusts_NS2 Says_Server_message_form)
*)

(****
 SESSION KEY COMPROMISE THEOREM.  To prove theorems of the form

  Key K \<in> analz (insert (Key KAB) (spies evs)) \<Longrightarrow>
  Key K \<in> analz (spies evs)

 A more general formula must be proved inductively.
****)

text{*NOT useful in this form, but it says that session keys are not used
  to encrypt messages containing other keys, in the actual protocol.
  We require that agents should behave like this subsequently also.*}
lemma  "\<lbrakk>evs \<in> ns_shared;  Kab \<notin> range shrK\<rbrakk> \<Longrightarrow>
         (Crypt KAB X) \<in> parts (spies evs) \<and>
         Key K \<in> parts {X} \<longrightarrow> Key K \<in> parts (spies evs)"
apply (erule ns_shared.induct, force, drule_tac [4] NS3_msg_in_parts_spies, simp_all)
txt{*Fake*}
apply (blast dest: parts_insert_subset_Un)
txt{*Base, NS4 and NS5*}
apply auto
done

subsubsection{*Session keys are not used to encrypt other session keys*}

text{*The equality makes the induction hypothesis easier to apply*}

lemma analz_image_freshK [rule_format]:
 "evs \<in> ns_shared \<Longrightarrow>
   \<forall>K KK. KK \<subseteq> - (range shrK) \<longrightarrow>
             (Key K \<in> analz (Key`KK \<union> (spies evs))) =
             (K \<in> KK \<or> Key K \<in> analz (spies evs))"
apply (erule ns_shared.induct)
apply (drule_tac [8] Says_Server_message_form)
apply (erule_tac [5] Says_S_message_form [THEN disjE], analz_freshK, spy_analz)
txt{*NS2, NS3*}
apply blast+
done

lemma analz_insert_freshK:
     "\<lbrakk>evs \<in> ns_shared;  KAB \<notin> range shrK\<rbrakk> \<Longrightarrow>
       (Key K \<in> analz (insert (Key KAB) (spies evs))) =
       (K = KAB \<or> Key K \<in> analz (spies evs))"
by (simp only: analz_image_freshK analz_image_freshK_simps)

subsubsection{*The session key K uniquely identifies the message*}

text{*In messages of this form, the session key uniquely identifies the rest*}
lemma unique_session_keys:
     "\<lbrakk>Says Server A (Crypt (shrK A) \<lbrace>NA, Agent B, Key K, X\<rbrace>) \<in> set evs;
       Says Server A' (Crypt (shrK A') \<lbrace>NA', Agent B', Key K, X'\<rbrace>) \<in> set evs;
       evs \<in> ns_shared\<rbrakk> \<Longrightarrow> A=A' \<and> NA=NA' \<and> B=B' \<and> X = X'"
by (erule rev_mp, erule rev_mp, erule ns_shared.induct, simp_all, blast+)

subsubsection{*Crucial secrecy property: Spy doesn't see the keys sent in NS2*}

text{*Beware of @{text "[rule_format]"} and the universal quantifier!*}
lemma secrecy_lemma:
     "\<lbrakk>Says Server A (Crypt (shrK A) \<lbrace>NA, Agent B, Key K,
                                      Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace>\<rbrace>)
              \<in> set evs;
         A \<notin> bad;  B \<notin> bad;  evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> (\<forall>NB. Notes Spy \<lbrace>NA, NB, Key K\<rbrace> \<notin> set evs) \<longrightarrow>
         Key K \<notin> analz (spies evs)"
apply (erule rev_mp)
apply (erule ns_shared.induct, force)
apply (frule_tac [7] Says_Server_message_form)
apply (frule_tac [4] Says_S_message_form)
apply (erule_tac [5] disjE)
apply (simp_all add: analz_insert_eq analz_insert_freshK pushes split_ifs, spy_analz)
txt{*NS2*}
apply blast
txt{*NS3*}
apply (blast dest!: Crypt_Spy_analz_bad A_trusts_NS2
             dest:  Says_imp_knows_Spy analz.Inj unique_session_keys)
txt{*Oops*}
apply (blast dest: unique_session_keys)
done

text{*Final version: Server's message in the most abstract form*}
lemma Spy_not_see_encrypted_key:
     "\<lbrakk>Says Server A (Crypt K' \<lbrace>NA, Agent B, Key K, X\<rbrace>) \<in> set evs;
       \<forall>NB. Notes Spy \<lbrace>NA, NB, Key K\<rbrace> \<notin> set evs;
       A \<notin> bad;  B \<notin> bad;  evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> Key K \<notin> analz (spies evs)"
by (blast dest: Says_Server_message_form secrecy_lemma)

subsection{*Guarantees available at various stages of protocol*}

text{*If the encrypted message appears then it originated with the Server*}
lemma B_trusts_NS3:
     "\<lbrakk>Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace> \<in> parts (spies evs);
       B \<notin> bad;  evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> \<exists>NA. Says Server A
               (Crypt (shrK A) \<lbrace>NA, Agent B, Key K,
                                 Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace>\<rbrace>)
              \<in> set evs"
apply (erule rev_mp)
apply (erule ns_shared.induct, force, drule_tac [4] NS3_msg_in_parts_spies, auto)
done

lemma A_trusts_NS4_lemma [rule_format]:
   "evs \<in> ns_shared \<Longrightarrow>
      Key K \<notin> analz (spies evs) \<longrightarrow>
      Says Server A (Crypt (shrK A) \<lbrace>NA, Agent B, Key K, X\<rbrace>) \<in> set evs \<longrightarrow>
      Crypt K (Nonce NB) \<in> parts (spies evs) \<longrightarrow>
      Says B A (Crypt K (Nonce NB)) \<in> set evs"
apply (erule ns_shared.induct, force, drule_tac [4] NS3_msg_in_parts_spies)
apply (analz_mono_contra, simp_all, blast)
txt{*NS2: contradiction from the assumptions @{term "Key K \<notin> used evs2"} and
    @{term "Crypt K (Nonce NB) \<in> parts (spies evs2)"} *}
apply (force dest!: Crypt_imp_keysFor)
txt{*NS4*}
apply (metis B_trusts_NS3 Crypt_Spy_analz_bad Says_imp_analz_Spy Says_imp_parts_knows_Spy analz.Fst unique_session_keys)
done

text{*This version no longer assumes that K is secure*}
lemma A_trusts_NS4:
     "\<lbrakk>Crypt K (Nonce NB) \<in> parts (spies evs);
       Crypt (shrK A) \<lbrace>NA, Agent B, Key K, X\<rbrace> \<in> parts (spies evs);
       \<forall>NB. Notes Spy \<lbrace>NA, NB, Key K\<rbrace> \<notin> set evs;
       A \<notin> bad;  B \<notin> bad;  evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> Says B A (Crypt K (Nonce NB)) \<in> set evs"
by (blast intro: A_trusts_NS4_lemma
          dest: A_trusts_NS2 Spy_not_see_encrypted_key)

text{*If the session key has been used in NS4 then somebody has forwarded
  component X in some instance of NS4.  Perhaps an interesting property,
  but not needed (after all) for the proofs below.*}
theorem NS4_implies_NS3 [rule_format]:
  "evs \<in> ns_shared \<Longrightarrow>
     Key K \<notin> analz (spies evs) \<longrightarrow>
     Says Server A (Crypt (shrK A) \<lbrace>NA, Agent B, Key K, X\<rbrace>) \<in> set evs \<longrightarrow>
     Crypt K (Nonce NB) \<in> parts (spies evs) \<longrightarrow>
     (\<exists>A'. Says A' B X \<in> set evs)"
apply (erule ns_shared.induct, force)
apply (drule_tac [4] NS3_msg_in_parts_spies)
apply analz_mono_contra
apply (simp_all add: ex_disj_distrib, blast)
txt{*NS2*}
apply (blast dest!: new_keys_not_used Crypt_imp_keysFor)
txt{*NS4*}
apply (metis B_trusts_NS3 Crypt_Spy_analz_bad Says_imp_analz_Spy Says_imp_parts_knows_Spy analz.Fst unique_session_keys)
done

lemma B_trusts_NS5_lemma [rule_format]:
  "\<lbrakk>B \<notin> bad;  evs \<in> ns_shared\<rbrakk> \<Longrightarrow>
     Key K \<notin> analz (spies evs) \<longrightarrow>
     Says Server A
          (Crypt (shrK A) \<lbrace>NA, Agent B, Key K,
                            Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace>\<rbrace>) \<in> set evs \<longrightarrow>
     Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace> \<in> parts (spies evs) \<longrightarrow>
     Says A B (Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace>) \<in> set evs"
apply (erule ns_shared.induct, force)
apply (drule_tac [4] NS3_msg_in_parts_spies)
apply (analz_mono_contra, simp_all, blast)
txt{*NS2*}
apply (blast dest!: new_keys_not_used Crypt_imp_keysFor)
txt{*NS5*}
apply (blast dest!: A_trusts_NS2
             dest: Says_imp_knows_Spy [THEN analz.Inj]
                   unique_session_keys Crypt_Spy_analz_bad)
done

text{*Very strong Oops condition reveals protocol's weakness*}
lemma B_trusts_NS5:
     "\<lbrakk>Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace> \<in> parts (spies evs);
       Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace> \<in> parts (spies evs);
       \<forall>NA NB. Notes Spy \<lbrace>NA, NB, Key K\<rbrace> \<notin> set evs;
       A \<notin> bad;  B \<notin> bad;  evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> Says A B (Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace>) \<in> set evs"
by (blast intro: B_trusts_NS5_lemma
          dest: B_trusts_NS3 Spy_not_see_encrypted_key)

text{*Unaltered so far wrt original version*}

subsection{*Lemmas for reasoning about predicate "Issues"*}

lemma spies_Says_rev: "spies (evs @ [Says A B X]) = insert X (spies evs)"
apply (induct_tac "evs")
apply (rename_tac [2] a b)
apply (induct_tac [2] "a", auto)
done

lemma spies_Gets_rev: "spies (evs @ [Gets A X]) = spies evs"
apply (induct_tac "evs")
apply (rename_tac [2] a b)
apply (induct_tac [2] "a", auto)
done

lemma spies_Notes_rev: "spies (evs @ [Notes A X]) =
          (if A:bad then insert X (spies evs) else spies evs)"
apply (induct_tac "evs")
apply (rename_tac [2] a b)
apply (induct_tac [2] "a", auto)
done

lemma spies_evs_rev: "spies evs = spies (rev evs)"
apply (induct_tac "evs")
apply (rename_tac [2] a b)
apply (induct_tac [2] "a")
apply (simp_all (no_asm_simp) add: spies_Says_rev spies_Gets_rev spies_Notes_rev)
done

lemmas parts_spies_evs_revD2 = spies_evs_rev [THEN equalityD2, THEN parts_mono]

lemma spies_takeWhile: "spies (takeWhile P evs) <=  spies evs"
apply (induct_tac "evs")
apply (rename_tac [2] a b)
apply (induct_tac [2] "a", auto)
txt{* Resembles @{text"used_subset_append"} in theory Event.*}
done

lemmas parts_spies_takeWhile_mono = spies_takeWhile [THEN parts_mono]

subsection{*Guarantees of non-injective agreement on the session key, and
of key distribution. They also express forms of freshness of certain messages,
namely that agents were alive after something happened.*}

lemma B_Issues_A:
     "\<lbrakk> Says B A (Crypt K (Nonce Nb)) \<in> set evs;
         Key K \<notin> analz (spies evs);
         A \<notin> bad;  B \<notin> bad; evs \<in> ns_shared \<rbrakk>
      \<Longrightarrow> B Issues A with (Crypt K (Nonce Nb)) on evs"
apply (simp (no_asm) add: Issues_def)
apply (rule exI)
apply (rule conjI, assumption)
apply (simp (no_asm))
apply (erule rev_mp)
apply (erule rev_mp)
apply (erule ns_shared.induct, analz_mono_contra)
apply (simp_all)
txt{*fake*}
apply blast
apply (simp_all add: takeWhile_tail)
txt{*NS3 remains by pure coincidence!*}
apply (force dest!: A_trusts_NS2 Says_Server_message_form)
txt{*NS4 would be the non-trivial case can be solved by Nb being used*}
apply (blast dest: parts_spies_takeWhile_mono [THEN subsetD]
                   parts_spies_evs_revD2 [THEN subsetD])
done

text{*Tells A that B was alive after she sent him the session key.  The
session key must be assumed confidential for this deduction to be meaningful,
but that assumption can be relaxed by the appropriate argument.

Precisely, the theorem guarantees (to A) key distribution of the session key
to B. It also guarantees (to A) non-injective agreement of B with A on the
session key. Both goals are available to A in the sense of Goal Availability.
*}
lemma A_authenticates_and_keydist_to_B:
     "\<lbrakk>Crypt K (Nonce NB) \<in> parts (spies evs);
       Crypt (shrK A) \<lbrace>NA, Agent B, Key K, X\<rbrace> \<in> parts (spies evs);
       Key K \<notin> analz(knows Spy evs);
       A \<notin> bad;  B \<notin> bad;  evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> B Issues A with (Crypt K (Nonce NB)) on evs"
by (blast intro: A_trusts_NS4_lemma B_Issues_A dest: A_trusts_NS2)

lemma A_trusts_NS5:
  "\<lbrakk> Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace> \<in> parts(spies evs);
     Crypt (shrK A) \<lbrace>Nonce NA, Agent B, Key K, X\<rbrace> \<in> parts(spies evs);
     Key K \<notin> analz (spies evs);
     A \<notin> bad; B \<notin> bad; evs \<in> ns_shared \<rbrakk>
 \<Longrightarrow> Says A B (Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace>) \<in> set evs"
apply (erule rev_mp)
apply (erule rev_mp)
apply (erule rev_mp)
apply (erule ns_shared.induct, analz_mono_contra)
apply (simp_all)
txt{*Fake*}
apply blast
txt{*NS2*}
apply (force dest!: Crypt_imp_keysFor)
txt{*NS3*}
apply (metis NS3_msg_in_parts_spies parts_cut_eq)
txt{*NS5, the most important case, can be solved by unicity*}
apply (metis A_trusts_NS2 Crypt_Spy_analz_bad Says_imp_analz_Spy Says_imp_parts_knows_Spy analz.Fst analz.Snd unique_session_keys)
done

lemma A_Issues_B:
     "\<lbrakk> Says A B (Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace>) \<in> set evs;
        Key K \<notin> analz (spies evs);
        A \<notin> bad;  B \<notin> bad; evs \<in> ns_shared \<rbrakk>
    \<Longrightarrow> A Issues B with (Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace>) on evs"
apply (simp (no_asm) add: Issues_def)
apply (rule exI)
apply (rule conjI, assumption)
apply (simp (no_asm))
apply (erule rev_mp)
apply (erule rev_mp)
apply (erule ns_shared.induct, analz_mono_contra)
apply (simp_all)
txt{*fake*}
apply blast
apply (simp_all add: takeWhile_tail)
txt{*NS3 remains by pure coincidence!*}
apply (force dest!: A_trusts_NS2 Says_Server_message_form)
txt{*NS5 is the non-trivial case and cannot be solved as in @{term B_Issues_A}! because NB is not fresh. We need @{term A_trusts_NS5}, proved for this very purpose*}
apply (blast dest: A_trusts_NS5 parts_spies_takeWhile_mono [THEN subsetD]
        parts_spies_evs_revD2 [THEN subsetD])
done

text{*Tells B that A was alive after B issued NB.

Precisely, the theorem guarantees (to B) key distribution of the session key to A. It also guarantees (to B) non-injective agreement of A with B on the session key. Both goals are available to B in the sense of Goal Availability.
*}
lemma B_authenticates_and_keydist_to_A:
     "\<lbrakk>Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace> \<in> parts (spies evs);
       Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace> \<in> parts (spies evs);
       Key K \<notin> analz (spies evs);
       A \<notin> bad;  B \<notin> bad;  evs \<in> ns_shared\<rbrakk>
   \<Longrightarrow> A Issues B with (Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace>) on evs"
by (blast intro: A_Issues_B B_trusts_NS5_lemma dest: B_trusts_NS3)

end