           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2005         |
            |               February 2006               |
            |                  April 2006  (modified)   |
            |                  March 2007  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory FNF_F_sf_seq
imports FNF_F_sf_induct FNF_F_sf_ext
begin

(*  The following simplification rules are deleted in this theory file *)
(*  because they unexpectly rewrite UnionT and InterT.                 *)
(*                  disj_not1: (~ P | Q) = (P --> Q)                   *)

declare disj_not1 [simp del]

(*  The following simplification rules are deleted in this theory file *)
(*       P (if Q then x else y) = ((Q --> P x) & (~ Q --> P y))        *)
(* Isabelle 2017: split_if --> if_split *)

declare if_split  [split del]

(*****************************************************************

         1. full sequentialization for Sequential composition (P1 ;; P2)
         2.
         3.

 *****************************************************************)

(*============================================================*
 |                                                            |
 |                    Seq_compo P ;; Q                        |
 |                                                            |
 *============================================================*)

definition
  Pfun_Seq_compo :: "('p,'a) proc => (('p,'a) proc => ('p,'a) proc)"
  where
  Pfun_Seq_compo_def :
    "Pfun_Seq_compo P2 == (%P1. P1 ;; P2)"

definition
  SP_step_Seq_compo ::
   "('p,'a) proc => ('a set => ('a => ('p,'a) proc) => ('p,'a) proc =>
                               ('a => ('p,'a) proc) => ('p,'a) proc)"
  where
  SP_step_Seq_compo_def :
    "SP_step_Seq_compo P2 == (%Y1 Pf1 Q1 SPf.
     (if (Q1 = SKIP)
      then (((? x:Y1 -> SPf x) [+] STOP) [>seq P2)
      else if (Q1 = DIV)
      then (((? x:Y1 -> SPf x) [+] STOP) [>seq SDIV)
      else ((? x:Y1 -> SPf x) [+] STOP)))"

definition
  fsfF_Seq_compo :: "('p,'a) proc => ('p,'a) proc => ('p,'a) proc"
                               ("(1_ /;;seq _)" [79,78] 78)
  where
  fsfF_Seq_compo_def :
    "fsfF_Seq_compo == (%P1 P2.
       (fsfF_induct1 (Pfun_Seq_compo P2)
                     (SP_step_Seq_compo P2) P1))"

(*************************************************************
                  function fsfF fsfF -> fsfF
 *************************************************************)

lemma fsfF_Seq_compo_in:
    "[| P1 : fsfF_proc ; P2 : fsfF_proc |]
     ==> P1 ;;seq P2 : fsfF_proc"
apply (simp add: fsfF_Seq_compo_def)
apply (rule fsfF_induct1_in)
apply (simp_all add: SP_step_Seq_compo_def)
apply (simp split: if_split)
apply (intro conjI impI)
apply (rule fsfF_Timeout_in)
apply (simp_all add: fsfF_proc.intros)
apply (rule fsfF_Timeout_in)
apply (simp_all add: fsfF_proc.intros)
done

(*------------------------------------------------------------*
 |             syntactical transformation to fsfF             |
 *------------------------------------------------------------*)

lemma cspF_fsfF_Seq_compo_eqF:
    "P1 ;; P2 =F P1 ;;seq P2"
apply (simp add: fsfF_Seq_compo_def)
apply (rule cspF_rw_right)
apply (rule cspF_fsfF_induct1_eqF[THEN cspF_sym])
apply (simp_all add: Pfun_Seq_compo_def SP_step_Seq_compo_def)

apply (erule disjE)
      (* SKIP *)
apply (simp)

apply (rule cspF_rw_left)
apply (rule cspF_SKIP_DIV_Seq_compo_step_resolve)

apply (rule cspF_rw_right)
apply (rule cspF_fsfF_Timeout_eqF[THEN cspF_sym])
apply (rule cspF_decompo)
apply (rule cspF_decompo)
apply (rule cspF_rw_right)
apply (rule cspF_unit)
apply (rule cspF_reflex)
apply (rule cspF_reflex)
apply (rule cspF_reflex)

apply (erule disjE)
      (* DIV *)
apply (simp)

apply (rule cspF_rw_left)
apply (rule cspF_SKIP_DIV_Seq_compo_step_resolve)

apply (rule cspF_rw_right)
apply (rule cspF_fsfF_Timeout_eqF[THEN cspF_sym])
apply (rule cspF_rw_left)
apply (rule cspF_Ext_choice_SKIP_or_DIV_resolve)
apply (simp)
apply (rule cspF_decompo)
apply (rule cspF_decompo)
apply (rule cspF_rw_right)
apply (rule cspF_unit)
apply (rule cspF_reflex)
apply (rule cspF_reflex)
apply (rule cspF_SDIV_eqF)

      (* STOP *)
apply (simp)

apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (rule cspF_unit)
apply (rule cspF_reflex)
apply (rule cspF_rw_left)
apply (rule cspF_step)

apply (rule cspF_rw_right)
apply (rule cspF_unit)
apply (rule cspF_reflex)

(* congruence *)
apply (rule cspF_rw_left,
     (simp
     | rule cspF_IF_split[THEN cspF_sym]
     | rule cspF_fsfF_Timeout_eqF[THEN cspF_sym]
     | rule cspF_decompo
     | rule cspF_reflex)+ ,
       rule cspF_rw_right,
     (simp
     | rule cspF_IF_split[THEN cspF_sym]
     | rule cspF_fsfF_Timeout_eqF[THEN cspF_sym]
     | rule cspF_decompo
     | rule cspF_reflex)+)+
done

(****************** to add them again ******************)

declare if_split    [split]
declare disj_not1   [simp]

end


(*  Title:      HOL/Auth/n_german_lemma_inv__6_on_rules.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_german Protocol Case Study*}

theory n_german_lemma_inv__6_on_rules imports n_german_lemma_on_inv__6
begin
section{*All lemmas on causal relation between inv__6*}
lemma lemma_inv__6_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__6  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> j. j\<le>N\<and>r=n_SendReqS  j)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqEI  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqES  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReq N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvE  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)\<or>
    (\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> j. j\<le>N\<and>r=n_SendReqS  j)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqSVsinv__6) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendReqEI  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqEIVsinv__6) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendReqES  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqESVsinv__6) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReq N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqVsinv__6) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInvE  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInvEVsinv__6) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInvS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInvSVsinv__6) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInvAckVsinv__6) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvInvAckVsinv__6) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntSVsinv__6) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntEVsinv__6) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntSVsinv__6) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntEVsinv__6) done
    }

    moreover {
      assume d1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_StoreVsinv__6) done
    }

  ultimately show "invHoldForRule s f r (invariants N)"
  by satx
qed

end


theory Analyze_topos_generated
imports
  Iptables_Semantics.Parser
begin

parse_iptables_save factory_fw="imaginray_factory_network.iptables-save.by-linux-kernel"

thm factory_fw_def
thm factory_fw_FORWARD_default_policy_def

lemma "map (\<lambda>(c,rs). (c, map (quote_rewrite \<circ> common_primitive_rule_toString) rs)) factory_fw =
 [(''FORWARD'',
   [''-s 10.8.2.2/32 -d 10.8.8.1/32 -i Bot2 -o Watchdog -m state --state ESTABLISHED -j ACCEPT'',
    ''-s 10.8.2.1/32 -d 10.8.8.1/32 -i Bot1 -o Watchdog -m state --state ESTABLISHED -j ACCEPT'',
    ''-s 10.8.1.1/32 -d 10.8.0.1/32 -i MissionControl1 -o AdminPc -m state --state ESTABLISHED -j ACCEPT'',
    ''-s 10.8.1.2/32 -d 10.8.0.1/32 -i MissionControl2 -o AdminPc -m state --state ESTABLISHED -j ACCEPT'',
    ''-s 10.8.2.2/32 -d 10.8.1.2/32 -i Bot2 -o MissionControl2 -m state --state ESTABLISHED -j ACCEPT'',
    ''-s 10.8.2.1/32 -d 10.8.1.1/32 -i Bot1 -o MissionControl1 -m state --state ESTABLISHED -j ACCEPT'',
    ''-s 10.0.0.1/32 -d 10.0.0.2/32 -i Statistics -o SensorSink -m state --state ESTABLISHED -j ACCEPT'',
    ''-s 10.0.0.2/32 -d 10.0.1.2/32 -i SensorSink -o Webcam -m state --state ESTABLISHED -j ACCEPT'',
    ''-s 10.0.1.1/32 -d 10.0.0.2/32 -i PresenceSensor -o SensorSink -j ACCEPT'',
    ''-s 10.0.1.2/32 -d 10.0.0.2/32 -i Webcam -o SensorSink -j ACCEPT'',
    ''-s 10.0.1.3/32 -d 10.0.0.2/32 -i TempSensor -o SensorSink -j ACCEPT'',
    ''-s 10.0.1.4/32 -d 10.0.0.2/32 -i FireSensor -o SensorSink -j ACCEPT'',
    ''-s 10.0.0.2/32 -d 10.0.0.1/32 -i SensorSink -o Statistics -j ACCEPT'',
    ''-s 10.8.1.1/32 -d 10.8.2.1/32 -i MissionControl1 -o Bot1 -j ACCEPT'',
    ''-s 10.8.1.1/32 -d 10.8.2.2/32 -i MissionControl1 -o Bot2 -j ACCEPT'',
    ''-s 10.8.1.2/32 -d 10.8.2.2/32 -i MissionControl2 -o Bot2 -j ACCEPT'',
    ''-s 10.8.0.1/32 -d 10.8.1.2/32 -i AdminPc -o MissionControl2 -j ACCEPT'',
    ''-s 10.8.0.1/32 -d 10.8.1.1/32 -i AdminPc -o MissionControl1 -j ACCEPT'',
    ''-s 10.8.8.1/32 -d 10.8.2.1/32 -i Watchdog -o Bot1 -j ACCEPT'',
    ''-s 10.8.8.1/32 -d 10.8.2.2/32 -i Watchdog -o Bot2 -j ACCEPT'']),
  (''INPUT'', []),
  (''OUTPUT'', [])]" by eval

definition "unfolded_FORWARD = unfold_ruleset_FORWARD factory_fw_FORWARD_default_policy (map_of_string_ipv4 (factory_fw))"

value[code] "map (quote_rewrite \<circ> common_primitive_rule_toString) (unfolded_FORWARD)"

value[code] "map (quote_rewrite \<circ> common_primitive_rule_toString) (upper_closure unfolded_FORWARD)"

value[code] "upper_closure (packet_assume_new unfolded_FORWARD)"

lemma "check_simple_fw_preconditions (upper_closure (optimize_matches abstract_for_simple_firewall
          (upper_closure (packet_assume_new unfolded_FORWARD))))" by eval

lemma "simple_fw_valid (to_simple_firewall (upper_closure
              (optimize_matches abstract_for_simple_firewall (upper_closure (packet_assume_new unfolded_FORWARD)))))"
by eval
lemma "simple_fw_valid (to_simple_firewall (lower_closure
              (optimize_matches abstract_for_simple_firewall (lower_closure (packet_assume_new unfolded_FORWARD)))))"
by eval

value[code] "map simple_rule_ipv4_toString (to_simple_firewall (upper_closure
              (optimize_matches abstract_for_simple_firewall (upper_closure (packet_assume_new unfolded_FORWARD)))))"

value[code] "map simple_rule_ipv4_toString (to_simple_firewall (lower_closure
              (optimize_matches abstract_for_simple_firewall (lower_closure (packet_assume_new unfolded_FORWARD)))))"

(*Interfaces be gone! necessary for ip partition!*)
definition preprocess where
  "preprocess unfold closure ipassmt def fw \<equiv> to_simple_firewall (closure
              (optimize_matches (abstract_primitive (\<lambda>r. case r of Pos a \<Rightarrow> is_Iiface a \<or> is_Oiface a \<or> is_L4_Flags a
                                                                 | Neg a \<Rightarrow> is_Iiface a \<or> is_Oiface a \<or> is_Prot a \<or> is_L4_Flags a))
              (closure
              (iface_try_rewrite ipassmt None
              (closure
              (packet_assume_new
              (unfold def (map_of fw))))))))"

  (*incomplete, but we won't need it anyway*)
 definition ipassmt :: "(iface \<times> (32 word \<times> nat) list) list" where
 "ipassmt = [(Iface ''lo'', [(ipv4addr_of_dotdecimal (127,0,0,0),8)]),
  (Iface ''Statistics'', [(ipv4addr_of_dotdecimal (10,0,0,1),32)])
  ]"
  lemma "distinct (map fst ipassmt)" by eval
  lemma "ipassmt_sanity_nowildcards (map_of ipassmt)" by eval
  value[code] "map_of_ipassmt ipassmt"

value[code] "access_matrix_pretty_ipv4 parts_connection_ssh
    (preprocess unfold_ruleset_FORWARD upper_closure ipassmt factory_fw_FORWARD_default_policy factory_fw)"

lemma "access_matrix_pretty_ipv4 parts_connection_http (
      preprocess unfold_ruleset_FORWARD upper_closure ipassmt factory_fw_FORWARD_default_policy factory_fw) =
([ (''10.8.8.1'', ''10.8.8.1''),
   (''10.8.2.2'', ''10.8.2.2''),
   (''10.8.2.1'', ''10.8.2.1''),
   (''10.8.1.2'', ''10.8.1.2''),
   (''10.8.1.1'', ''10.8.1.1''),
   (''10.8.0.1'', ''10.8.0.1''),
   (''10.0.1.1'', ''{10.0.1.1 .. 10.0.1.4}''),
   (''10.0.0.2'', ''10.0.0.2''),
   (''10.0.0.1'', ''10.0.0.1''),
   (''0.0.0.0'',  ''{0.0.0.0 .. 10.0.0.0} u {10.0.0.3 .. 10.0.1.0} u {10.0.1.5 .. 10.8.0.0} u ''@
                  ''{10.8.0.2 .. 10.8.1.0} u {10.8.1.3 .. 10.8.2.0} u {10.8.2.3 .. 10.8.8.0} u {10.8.8.2 .. 255.255.255.255}'')],
  [(''10.8.8.1'', ''10.8.2.2''),
   (''10.8.8.1'', ''10.8.2.1''),
   (''10.8.1.2'', ''10.8.2.2''),
   (''10.8.1.1'', ''10.8.2.2''),
   (''10.8.1.1'', ''10.8.2.1''),
   (''10.8.0.1'', ''10.8.1.2''),
   (''10.8.0.1'', ''10.8.1.1''),
   (''10.0.1.1'', ''10.0.0.2''),
   (''10.0.0.2'', ''10.0.0.1'')])" by eval

text\<open>@{const CT_Established}\<close>
lemma "access_matrix_pretty_ipv4 parts_connection_ssh
    (to_simple_firewall (upper_closure
              (optimize_matches (abstract_primitive (\<lambda>r. case r of Pos a \<Rightarrow> is_Iiface a \<or> is_Oiface a \<or> is_L4_Flags a
                                                                 | Neg a \<Rightarrow> is_Iiface a \<or> is_Oiface a \<or> is_Prot a \<or> is_L4_Flags a))
              (upper_closure
              (iface_try_rewrite ipassmt None
              (upper_closure
              (optimize_matches (ctstate_assume_state CT_Established)
              (unfold_ruleset_FORWARD factory_fw_FORWARD_default_policy (map_of factory_fw))))))))) =
([(''10.8.8.1'', ''10.8.8.1''),
   (''10.8.2.2'', ''10.8.2.2''),
   (''10.8.2.1'', ''10.8.2.1''),
   (''10.8.1.2'', ''10.8.1.2''),
   (''10.8.1.1'', ''10.8.1.1''),
   (''10.8.0.1'', ''10.8.0.1''),
   (''10.0.1.1'', ''10.0.1.1 u {10.0.1.3 .. 10.0.1.4}''),
   (''10.0.0.1'', ''10.0.0.1 u 10.0.1.2''),
   (''10.0.0.2'', ''10.0.0.2''),
   (''0.0.0.0'',  ''{0.0.0.0 .. 10.0.0.0} u {10.0.0.3 .. 10.0.1.0} u {10.0.1.5 .. 10.8.0.0} u ''@
                  ''{10.8.0.2 .. 10.8.1.0} u {10.8.1.3 .. 10.8.2.0} u {10.8.2.3 .. 10.8.8.0} u {10.8.8.2 .. 255.255.255.255}'')],
  [(''10.8.8.1'', ''10.8.2.2''),
   (''10.8.8.1'', ''10.8.2.1''),
   (''10.8.2.2'', ''10.8.8.1''),
   (''10.8.2.2'', ''10.8.1.2''),
   (''10.8.2.1'', ''10.8.8.1''),
   (''10.8.2.1'', ''10.8.1.1''),
   (''10.8.1.2'', ''10.8.2.2''),
   (''10.8.1.2'', ''10.8.0.1''),
   (''10.8.1.1'', ''10.8.2.2''),
   (''10.8.1.1'', ''10.8.2.1''),
   (''10.8.1.1'', ''10.8.0.1''),
   (''10.8.0.1'', ''10.8.1.2''),
   (''10.8.0.1'', ''10.8.1.1''),
   (''10.0.1.1'', ''10.0.0.2''),
   (''10.0.0.1'', ''10.0.0.2''),
   (''10.0.0.2'', ''10.0.0.1'')])" by eval

end


theory WordArrayT
  imports "AutoCorres.AutoCorres" "WordArraySpec"
begin

install_C_file "main_pp_inferred.c"
autocorres  [ts_rules = nondet] "main_pp_inferred.c"

context main_pp_inferred begin

type_synonym u32 = "32 word"

section \<open> Frame Constraints \<close>

definition frame_word32_ptr :: "lifted_globals \<Rightarrow> (word32 ptr) set \<Rightarrow> lifted_globals \<Rightarrow> (word32 ptr)  set \<Rightarrow> (word32 ptr) set \<Rightarrow> bool"
  where
  "frame_word32_ptr s p\<^sub>i s' p\<^sub>o ign \<equiv> \<forall>p :: word32 ptr.
                          (p \<in> p\<^sub>i \<and> p \<notin> p\<^sub>o \<and> p \<notin> ign \<longrightarrow> \<not> is_valid_w32 s' p) \<comment> \<open>leak freedom\<close>
                       \<and>  (p \<notin> p\<^sub>i \<and> p \<in> p\<^sub>o \<and> p \<notin> ign\<longrightarrow> \<not> is_valid_w32 s  p) \<comment> \<open>fresh allocation\<close>
                       \<and>  (p \<notin> p\<^sub>i \<and> p \<notin> p\<^sub>o \<and> p \<notin> ign \<longrightarrow>
                               (is_valid_w32 s p = is_valid_w32 s' p) \<and>  is_valid_w32 s p \<longrightarrow>
                               heap_w32 s  p = heap_w32 s' p)" \<comment> \<open>inertia\<close>

definition frame_WordArray_u32_C_ptr :: "lifted_globals \<Rightarrow> (WordArray_u32_C ptr) set \<Rightarrow> lifted_globals \<Rightarrow> (WordArray_u32_C ptr) set \<Rightarrow> (WordArray_u32_C ptr) set \<Rightarrow> bool"
  where
  "frame_WordArray_u32_C_ptr s p\<^sub>i s' p\<^sub>o ign \<equiv> \<forall>p :: WordArray_u32_C ptr.
                       (p \<in> p\<^sub>i \<and> p \<notin> p\<^sub>o \<and> p \<notin> ign \<longrightarrow> \<not> is_valid_WordArray_u32_C s' p) \<comment> \<open>leak freedom\<close>
                       \<and>  (p \<notin> p\<^sub>i \<and> p \<in> p\<^sub>o \<and> p \<notin> ign \<longrightarrow> \<not> is_valid_WordArray_u32_C s  p) \<comment> \<open>fresh allocation\<close>
                       \<and>  (p \<notin> p\<^sub>i \<and> p \<notin> p\<^sub>o \<and> p \<notin> ign \<longrightarrow>
                               (is_valid_WordArray_u32_C s p = is_valid_WordArray_u32_C s' p) \<and>
                               (is_valid_WordArray_u32_C s p \<longrightarrow>
                               heap_WordArray_u32_C s  p = heap_WordArray_u32_C s' p))" \<comment> \<open>inertia\<close>

lemmas frame_def = frame_WordArray_u32_C_ptr_def frame_word32_ptr_def

lemma frame_triv_w32_ptr: "frame_WordArray_u32_C_ptr state P state P ign"
  using frame_WordArray_u32_C_ptr_def by blast

lemma frame_triv_w32: "frame_word32_ptr state P state P ign"
  using frame_word32_ptr_def by blast

lemmas frame_triv = frame_triv_w32_ptr frame_triv_w32

lemma frame_weaken_w32:
  "\<lbrakk> A \<subseteq> A'; frame_word32_ptr s A s' A I\<rbrakk> \<Longrightarrow> frame_word32_ptr s A' s' A' I"
  apply (clarsimp simp add: frame_word32_ptr_def)
  by blast

lemma frame_combine_w32:
  "\<lbrakk>frame_word32_ptr s A s' A' I\<^sub>A; frame_word32_ptr s B s' B' I\<^sub>B;
    I\<^sub>A \<inter> A = {}; I\<^sub>A \<inter> A' = {}; I\<^sub>B \<inter> B = {}; I\<^sub>B \<inter> B' = {}; I = (I\<^sub>A \<union> I\<^sub>B) - (A \<union> A' \<union> B \<union> B')\<rbrakk>
    \<Longrightarrow> frame_word32_ptr s (A \<union> B) s' (A' \<union> B') I"
  apply (clarsimp simp add: frame_word32_ptr_def)
  apply (rule conjI)
   apply clarsimp
   apply (erule_tac x = p in allE)+
   apply clarsimp
   apply (erule disjE; clarsimp; blast)
  apply (rule conjI)
   apply clarsimp
   apply (erule_tac x = p in allE)+
   apply clarsimp
   apply (erule disjE; clarsimp; blast)
  apply clarsimp
  done

lemma frame_weaken_w32_ptr:
  "\<lbrakk> A \<subseteq> A'; frame_WordArray_u32_C_ptr s A s' A I\<rbrakk> \<Longrightarrow> frame_WordArray_u32_C_ptr s A' s' A' I"
  apply (clarsimp simp add: frame_WordArray_u32_C_ptr_def)
  by blast

lemma frame_combine_w32_ptr:
  "\<lbrakk>frame_WordArray_u32_C_ptr s A s' A' I\<^sub>A; frame_WordArray_u32_C_ptr s B s' B' I\<^sub>B;
    I\<^sub>A \<inter> A = {}; I\<^sub>A \<inter> A' = {}; I\<^sub>B \<inter> B = {}; I\<^sub>B \<inter> B' = {}; I = (I\<^sub>A \<union> I\<^sub>B) - (A \<union> A' \<union> B \<union> B')\<rbrakk>
    \<Longrightarrow> frame_WordArray_u32_C_ptr s (A \<union> B) s' (A' \<union> B') I"
  apply (clarsimp simp add: frame_WordArray_u32_C_ptr_def)
  apply (rule conjI)
   apply clarsimp
   apply (erule_tac x = p in allE)+
   apply clarsimp
   apply (erule disjE; clarsimp; blast)
  apply (rule conjI)
   apply clarsimp
   apply (erule_tac x = p in allE)+
   apply clarsimp
   apply (erule disjE; clarsimp; blast)
  apply clarsimp
  done

lemmas frame_weaken = frame_weaken_w32 frame_weaken_w32_ptr

lemmas frame_combine = frame_combine_w32 frame_combine_w32_ptr

section \<open> Helper Lemmas \<close>

subsection \<open> Miscellaneous Pointer Lemmas \<close>

lemma cptr_add_add[simp]:
  "p +\<^sub>p m +\<^sub>p n = p +\<^sub>p (m + n)"
  by (cases p) (simp add: algebra_simps CTypesDefs.ptr_add_def)

subsection \<open> Helper Word Lemmas \<close>

lemma word_mult_cancel_right:
  fixes a b c :: "('a::len) word"
  assumes "0 \<le> a" "0 \<le> b" "0 \<le> c"
  assumes "uint a * uint c \<le> uint (max_word :: ('a::len) word)"
  assumes "uint b * uint c \<le> uint (max_word :: ('a::len) word)"
  shows "a * c = b * c \<longleftrightarrow> c = 0 \<or> a = b"
  apply (rule iffI)
   using assms
   apply (unfold word_mult_def word_of_int_def)
    apply (clarsimp simp:Abs_word_inject max_word_def uint_word_of_int m1mod2k uint_0_iff)
   apply fastforce
   done

lemmas words_mult_cancel_right =
  word_mult_cancel_right[where 'a=8]
  word_mult_cancel_right[where 'a=16]
  word_mult_cancel_right[where 'a=32]
  word_mult_cancel_right[where 'a=64]

lemma order_indices:
  fixes ptr :: "('a::c_type) ptr"
  assumes "n * size_of (TYPE('a)) \<le> unat (max_word :: 32 word)"
  assumes "m * size_of (TYPE('a)) \<le> unat (max_word :: 32 word)"
  assumes "n < m"
  assumes "size_of (TYPE('a)) > 0"
  shows "ptr +\<^sub>p int n \<noteq> ptr +\<^sub>p int m"
  apply (simp add: ptr_add_def)
  apply (rule notI)
  using assms
  apply (subst (asm) word_mult_cancel_right; simp add: uint_nat)
    apply (subst le_unat_uoi[where z = "max_word:: 32 word"])
     apply (metis le_def multi_lessD nat_less_le neq0_conv)
    apply (subst le_unat_uoi[where z = "max_word:: 32 word"])
     apply (metis le_def multi_lessD nat_less_le neq0_conv)
    apply (metis assms(1) int_ops(7) of_nat_mono)
   apply (subst le_unat_uoi[where z = "max_word:: 32 word"])
    apply (metis le_def multi_lessD nat_less_le neq0_conv)
   apply (subst le_unat_uoi[where z = "max_word:: 32 word"])
    apply (metis le_def multi_lessD nat_less_le neq0_conv)
    apply (metis int_ops(7) of_nat_mono)
  apply (erule disjE)
  using le_unat_uoi apply fastforce
  by (metis (mono_tags, hide_lams) le_unat_uoi less_irrefl_nat mult_cancel2 of_nat_mult)

lemma distinct_indices:
  fixes ptr :: "('a::c_type) ptr"
  assumes "n * size_of (TYPE('a)) \<le> unat (max_word :: 32 word)"
  assumes "m * size_of (TYPE('a)) \<le> unat (max_word :: 32 word)"
  assumes "n \<noteq> m"
  assumes "size_of (TYPE('a)) > 0"
  shows "ptr +\<^sub>p int n \<noteq> ptr +\<^sub>p int m"
  using assms
  apply (case_tac "n < m")
   apply (erule order_indices; clarsimp)
  by (metis linorder_neqE_nat order_indices)

subsection \<open> arrlist \<close>

fun arrlist :: "('a :: c_type ptr \<Rightarrow> 'b) \<Rightarrow> ('a :: c_type ptr \<Rightarrow> bool) \<Rightarrow> 'b list \<Rightarrow> 'a ptr \<Rightarrow> bool"
  where
  "arrlist h v [] p = True" |
  "arrlist h v (x # xs) p = (v p \<and> h p = x \<and> arrlist h v xs (p +\<^sub>p 1))"

lemma arrlist_nth_value:
  assumes "arrlist h v xs p" "i < length xs"
  shows "h (p +\<^sub>p i) = xs ! i"
  using assms
proof (induct i arbitrary: p xs)
  case 0
  then show ?case
    apply(cases xs)
    by(auto)
next
  case (Suc i)
  then have "i < length (tl xs)" by (cases xs) auto
  have "h (p +\<^sub>p 1 +\<^sub>p int i) = tl xs ! i"
    apply(rule Suc)
     apply(case_tac [!] xs)
    using Suc by auto
  then show ?case using Suc by (auto simp: nth_tl)
qed

lemma arrlist_nth_valid:
  assumes "arrlist h v xs p"  "i < length xs"
  shows "v (p +\<^sub>p i)"
  using assms
proof (induct i arbitrary: p xs)
  case 0 then show ?case by (cases xs) auto
next
  case (Suc i)
  then have "i < length (tl xs)" by (cases xs) auto
  have "v ((p +\<^sub>p 1) +\<^sub>p int i)"
    apply (rule Suc.hyps[where xs="tl xs"])
      apply (case_tac [!] xs)
    using Suc by auto
  then show ?case by simp
qed

lemmas arrlist_nth = arrlist_nth_value arrlist_nth_valid

lemma case_Suc:
  "\<forall>i < Suc n.  P i \<Longrightarrow> (\<forall>i < n . P (Suc i)) \<and> P 0"
  by simp

lemma to_arrlist:
  assumes val_heap: "\<forall>k <  length xs. v (p +\<^sub>p int k) \<and> h (p +\<^sub>p int k) = xs ! k"
  shows "arrlist h v xs p"
  using assms
  apply (induct xs arbitrary: p)
   apply simp
  apply simp
  apply (rule conjI)
   apply (erule_tac x = 0 in allE)
   apply clarsimp
  apply (rule conjI)
   apply (erule_tac x = 0 in allE)
   apply clarsimp
  apply (drule_tac x = "p +\<^sub>p 1" in meta_spec, simp)
  apply (case_tac xs, simp)
  apply (drule case_Suc, simp)
  done

lemma arrlist_all_nth:
  "arrlist h v xs p \<longleftrightarrow>
    (\<forall>k < length xs. v (p +\<^sub>p int k) \<and> h (p +\<^sub>p int k) = xs ! k)"
  apply (intro iffI conjI allI impI)
    apply (clarsimp simp: arrlist_nth_valid)
   apply (clarsimp simp: arrlist_nth_value)
  apply (erule to_arrlist)
  done

section \<open> Word Array Abstraction \<close>

definition u32list :: "lifted_globals \<Rightarrow> u32 list \<Rightarrow> u32 ptr \<Rightarrow> bool"
  where
  "u32list s xs p \<equiv> arrlist (heap_w32 s) (is_valid_w32 s) xs p"

lemmas u32list_nth =
 arrlist_nth
  [where h="heap_w32 s" and v="is_valid_w32 (s :: lifted_globals)" for s,
   simplified u32list_def[symmetric]]

lemmas u32list_all_nth =
  arrlist_all_nth
    [where h="heap_w32 s" and v="is_valid_w32 (s :: lifted_globals)" for s,
      simplified u32list_def[symmetric]]

abbreviation "w_val h w \<equiv> values_C (h w)"
abbreviation "w_len h w \<equiv> len_C (h w)"

abbreviation "w_p s w \<equiv> w_val (heap_WordArray_u32_C s) w"
abbreviation "w_l s w \<equiv> w_len (heap_WordArray_u32_C s) w"

(* Converts a wordarray to a list *)
definition \<alpha> :: "lifted_globals \<Rightarrow> u32 list \<Rightarrow> WordArray_u32_C ptr \<Rightarrow> bool"
  where
  "\<alpha> s xs w \<equiv>
    u32list s xs (w_p s w)
    \<and> (unat (w_l s w)) = length xs
    \<and> is_valid_WordArray_u32_C s w
    \<and> 4 * length xs \<le> unat (max_word:: 32 word)"

lemma abs_length_eq:
  "\<alpha> s xs w \<Longrightarrow> unat (w_len (heap_WordArray_u32_C s) w) = length xs"
  by (clarsimp simp add: \<alpha>_def)

lemma \<alpha>_nth:
  fixes i :: int
  assumes
    "\<alpha> s xs w"
    "0 \<le> i" "i < length xs"
    "i = int n"
  shows "heap_w32 s ((w_val (heap_WordArray_u32_C s) w) +\<^sub>p i) = xs ! n"
    and "is_valid_w32 s ((w_val (heap_WordArray_u32_C s) w) +\<^sub>p i)"
  using u32list_nth assms
  unfolding \<alpha>_def
  by auto

lemma \<alpha>_all_nth:
  "\<alpha> s xs w \<longleftrightarrow> (unat (w_l s w)) = length xs
    \<and> is_valid_WordArray_u32_C s w
    \<and> 4 * length xs \<le> unat (max_word:: 32 word)
    \<and> (\<forall>k<length xs. is_valid_w32 s ((w_p s w) +\<^sub>p int k) \<and> heap_w32 s ((w_p s w) +\<^sub>p int k) = xs ! k)"
  apply (rule iffI)
   apply (clarsimp simp: \<alpha>_def u32list_all_nth)
  apply (clarsimp simp: \<alpha>_def u32list_all_nth)
  done

section \<open> Refinement and Frame Proofs \<close>

subsection \<open> wordarray\_get \<close>

lemma wordarray_get_refinement:
  "\<lbrace>\<lambda>s. \<alpha> s xs w \<rbrace>
    wordarray_get_0' (t1_C w i)
   \<lbrace>\<lambda>r s. \<alpha> s xs w \<and> r = w_get xs (unat i) \<rbrace>!"
  apply (unfold wordarray_get_0'_def)
  apply clarsimp
  apply wp
  apply (clarsimp simp: w_get_def)
  apply (safe; clarsimp simp: uint_nat word_le_nat_alt \<alpha>_nth abs_length_eq)
  apply (simp_all add: \<alpha>_def)
  done

lemma wordarray_get_frame:
  "\<lbrace>\<lambda>s. state = s \<and> \<alpha> s xs w \<rbrace>
    wordarray_get_0' (t1_C w i)
   \<lbrace>\<lambda>r s. frame_WordArray_u32_C_ptr state {} s {} {} \<and>
         frame_word32_ptr state {} s {} {}\<rbrace>!"
  apply(unfold wordarray_get_0'_def)
  apply(clarsimp)
  apply(wp)
  apply (safe; clarsimp simp: uint_nat word_le_nat_alt frame_triv \<alpha>_nth abs_length_eq)
  apply (simp add: \<alpha>_def)
  done

subsection \<open> wordarray\_length \<close>

lemma wordarray_length_refinement:
  "\<lbrace>\<lambda>s. \<alpha> s xs w\<rbrace>
    wordarray_length_0' w
   \<lbrace>\<lambda>r s. \<alpha> s xs w \<and> (unat r) = w_length xs\<rbrace>!"
  apply(unfold wordarray_length_0'_def)
  apply(unfold w_length_def)
  apply(clarsimp)
  apply(wp)
  by (clarsimp simp: \<alpha>_def)

lemma wordarray_length_frame:
  "\<lbrace>\<lambda>s. state = s \<and> \<alpha> s xs w \<rbrace>
    wordarray_length_0' w
   \<lbrace>\<lambda>r s. frame_WordArray_u32_C_ptr state {} s {} {} \<and>
         frame_word32_ptr state {} s {} {}\<rbrace>!"
  apply(unfold wordarray_length_0'_def)
  apply(clarsimp)
  apply(wp)
  apply (clarsimp simp: frame_triv \<alpha>_def)
  done

subsection \<open> wordarray\_put2 \<close>

lemma wordarray_same_address:
  "\<lbrakk>\<alpha> s xs w; n < length xs; m < length xs\<rbrakk> \<Longrightarrow>
    ((w_val (heap_WordArray_u32_C s) w) +\<^sub>p int n = (w_val (heap_WordArray_u32_C s) w) +\<^sub>p int m)
     = (n = m)"
  apply (simp add: \<alpha>_def)
  using distinct_indices apply force
  done

lemma wordarray_distinct_address:
  "\<lbrakk>\<alpha> s xs w; n < length xs; m < length xs\<rbrakk> \<Longrightarrow>
    (w_val (heap_WordArray_u32_C s) w) +\<^sub>p int n \<noteq> (w_val (heap_WordArray_u32_C s) w) +\<^sub>p int m
    \<longrightarrow> n \<noteq> m"
  apply (intro allI impI)
  apply clarsimp
  done

(*(heap_w32_update (\<lambda>a b. if b = values_C (heap_WordArray_u32_C state w) +\<^sub>p uint i then v else a b) state)*)
lemma wordarray_put2_frame:
  "\<lbrace>\<lambda>s. state = s \<and> \<alpha> s xs w \<rbrace>
    wordarray_put2_0' (t2_C w i v)
   \<lbrace>\<lambda>r s. frame_WordArray_u32_C_ptr state {} s {} {} \<and>
         frame_word32_ptr state { (w_p s w) +\<^sub>p uint i} s {(w_p s w) +\<^sub>p uint i } {} \<rbrace>!"
  apply (unfold wordarray_put2_0'_def)
  apply clarsimp
  apply wp
  apply clarsimp
  apply (rule conjI; clarsimp simp: uint_nat word_less_def abs_length_eq \<alpha>_nth)
   apply (simp add: frame_WordArray_u32_C_ptr_def frame_word32_ptr_def \<alpha>_def)
  apply (simp add: frame_triv \<alpha>_def)
  done

lemma wordarray_put2_refinement:
  "\<lbrace>\<lambda>s. \<alpha> s xs w \<rbrace>
    wordarray_put2_0' (t2_C w i v)
   \<lbrace>\<lambda>r s. \<alpha> s (w_put xs (unat i) v) r\<rbrace>!"
  apply (unfold wordarray_put2_0'_def w_put_def)
  apply clarsimp
  apply wp
  apply (clarsimp simp: uint_nat)
  apply (rule conjI)
   apply (clarsimp simp: word_less_nat_alt abs_length_eq)
   apply (rule conjI)
    apply (simp (no_asm) add: \<alpha>_def u32list_all_nth)
    apply (rule conjI)
     apply clarsimp
     apply (rule conjI)
      apply (clarsimp simp: wordarray_same_address \<alpha>_nth)
     apply (clarsimp simp: wordarray_distinct_address \<alpha>_nth)
    apply (simp add: \<alpha>_def)
   apply (clarsimp simp: \<alpha>_nth \<alpha>_def)
  apply (clarsimp simp: not_less word_le_nat_alt \<alpha>_def)
  done

lemma wordarray_put_no_fail:
  "\<alpha> s xs w \<Longrightarrow> \<not> snd (wordarray_put2_0' (t2_C w i v) s)"
  apply (monad_eq simp: wordarray_put2_0'_def)
  apply safe
   apply (simp add: \<alpha>_def)
  apply clarsimp
  apply (frule abs_length_eq)
  apply (subgoal_tac "unat i < length xs")
   apply (metis (full_types) \<alpha>_def int_unat u32list_all_nth w_length_def)
  by (simp add: word_less_nat_alt)

subsection \<open> wordarray\_fold\_no\_break \<close>

fun fold_dispatch :: "int \<Rightarrow> t3_C \<Rightarrow> word32"
  where
  "fold_dispatch n args = (if n = sint FUN_ENUM_mul_bod
                           then t3_C.elem_C args * t3_C.acc_C args
                           else t3_C.elem_C args + t3_C.acc_C args)"

definition f_n
  where
  "f_n \<equiv> (\<lambda>n a1 a2 a3. fold_dispatch (sint n) (t3_C a2 a1 a3))"

lemma unat_min:
  "unat (min a b) = min (unat a) (unat b)"
  by (simp add: min_of_mono' word_le_nat_alt)

lemma fold_loop_inv:
  "\<lbrace>\<lambda>s. \<alpha> s xs w \<and> r = (xa, y) \<and> y < ret \<and> ret = min to (w_l s w) \<and> frm \<le> y \<and>
        xd = t3_C.elem_C_update (\<lambda>a. heap_w32 s ((w_p s w) +\<^sub>p uint y)) xa \<and>
        w_fold xs (unat frm) (unat to) (f_n f_num) acc obsv =
        w_fold xs (unat y) (unat to) (f_n f_num) (t3_C.acc_C xa) obsv\<rbrace>
    dispatch_t4' (sint f_num) xd
   \<lbrace>\<lambda>xe a. \<alpha> a xs w \<and> ret = min to (len_C (heap_WordArray_u32_C a w)) \<and> frm \<le> y + 1 \<and>
           w_fold xs (unat frm) (unat to) (f_n f_num) acc obsv =
           w_fold xs (unat (y + 1)) (unat to) (f_n f_num) xe obsv \<and>
           min (unat to) (length xs) - unat (y + 1) <
           (case r of (fargs, i) \<Rightarrow> \<lambda>s. min (unat to) (length xs) - unat i) s\<rbrace>!"
  unfolding dispatch_t4'_def mul_bod'_def sum_bod'_def
  apply wp
  apply (clarsimp simp: word_less_nat_alt unatSuc2 less_is_non_zero_p1 word_le_nat_alt)
  apply (clarsimp simp: unat_min abs_length_eq)
  apply (simp add: diff_less_mono2)
  apply (case_tac "unat frm < length xs")
   apply (case_tac "unat frm < unat to")
    apply (simp add: \<alpha>_nth uint_nat)
    apply (simp (no_asm) add: f_n_def)
    apply (clarsimp simp: w_fold_step)
   apply simp_all
  done

lemma wordarray_fold_refinement:
  "\<lbrace>\<lambda>s. \<alpha> s xs w \<rbrace>
   wordarray_fold_no_break_0' (t5_C acc w f_num frm obsv to)
   \<lbrace>\<lambda>r s. \<alpha> s xs w \<and> r = w_fold xs (unat frm) (unat to) (f_n f_num) acc obsv\<rbrace>!"
  unfolding wordarray_fold_no_break_0'_def
  apply wp
      apply(subst whileLoop_add_inv[where I = "\<lambda>(fargs, i) s. \<alpha> s xs w  \<and> ret = min to (w_l s w) \<and>
                                   frm \<le> i \<and>
                                   w_fold xs (unat frm) (unat to) (f_n f_num) acc obsv =
                                   w_fold xs (unat i) (unat to) (f_n f_num) (t3_C.acc_C fargs) obsv"
                                   and
                                   M = "\<lambda>((fargs, i), s). (min (unat to) (length xs)) -  unat i"])
      apply wp
           apply simp
           apply (rule fold_loop_inv)
          apply wp
         apply wp
        apply wp
       apply (clarsimp simp: word_less_nat_alt uint_nat \<alpha>_nth abs_length_eq unat_min)
       apply (rule conjI, simp)+
       apply (simp add: \<alpha>_def)
      apply (safe; clarsimp simp add: not_less word_le_nat_alt w_fold_def abs_length_eq)
     apply wp
    apply wp
   apply wp
  apply clarsimp
  apply safe
    apply (simp add: min.commute min.strict_order_iff)
  using min.strict_order_iff apply fastforce
  apply (simp add: \<alpha>_def)
  done

lemma fold_loop_frame_inv:

  "\<lbrace>\<lambda>s. \<alpha> s xs w \<and> r = (xa, y) \<and> y < ret \<and> ret = min to (w_l s w) \<and> frm \<le> y \<and>
        xd = t3_C.elem_C_update (\<lambda>a. heap_w32 s ((w_p s w) +\<^sub>p uint y)) xa \<and>
        frame_WordArray_u32_C_ptr state {} s {} A \<and> frame_word32_ptr state {} s {} B\<rbrace>
    dispatch_t4' (sint f) xd
   \<lbrace>\<lambda>xe a. \<alpha> a xs w \<and> ret = min to (len_C (heap_WordArray_u32_C a w)) \<and> frm \<le> y + 1 \<and>
           frame_WordArray_u32_C_ptr state {} a {} A \<and> frame_word32_ptr state {} a {} B \<and>
           min (unat to) (length xs) - unat (y + 1) <
           (case r of (fargs, i) \<Rightarrow> \<lambda>s. min (unat to) (length xs) - unat i) s\<rbrace>!"
  unfolding dispatch_t4'_def sum_bod'_def mul_bod'_def
  apply wp
  apply (clarsimp simp: word_le_nat_alt unatSuc2 less_is_non_zero_p1 word_less_nat_alt)
  by (simp add: diff_less_mono2 abs_length_eq unat_min)

lemma wordarray_fold_frame:
  "\<lbrace>\<lambda>s. \<alpha> s xs w \<and> state = s \<and> w \<notin> A \<and> (\<forall>i < length xs. p +\<^sub>p i \<notin> B)\<rbrace>
    wordarray_fold_no_break_0' (t5_C acc w f frm obsv to)
   \<lbrace>\<lambda>r s. frame_WordArray_u32_C_ptr state {} s {} A \<and>
         frame_word32_ptr state {} s {} B \<rbrace>!"
  unfolding wordarray_fold_no_break_0'_def
  apply wp
      apply(subst whileLoop_add_inv[where I ="\<lambda>(fargs, i) s. \<alpha> s xs w \<and> ret = min to (w_l s w) \<and>
                                          frm \<le> i \<and> frame_WordArray_u32_C_ptr state {} s {} A \<and>
                                          frame_word32_ptr state {} s {} B" and
                                      M = "\<lambda>((fargs, i), s). (min (unat to) (length xs)) - unat i"])
      apply wp
           apply simp
           apply (rule fold_loop_frame_inv)
          apply wp
         apply wp
        apply wp
       apply (clarsimp simp: word_less_nat_alt uint_nat \<alpha>_nth abs_length_eq unat_min)
       apply (rule conjI, simp)+
       apply (simp add: \<alpha>_def)
      apply clarsimp
     apply wp
    apply wp
   apply wp
  apply (clarsimp simp: frame_triv frame_def)
  apply safe
    apply (simp add: min.commute min.strict_order_iff)
   apply (metis min.idem min.strict_order_iff neqE)
  apply (simp add: \<alpha>_def)
  done

subsection \<open> wordarray\_map\_no\_break \<close>

fun map_dispatch :: "int \<Rightarrow> t6_C \<Rightarrow> word32 \<times> unit_t_C"
  where
  "map_dispatch n args = (if n = sint FUN_ENUM_inc then ((t6_C.elem_C args + 1), (t6_C.acc_C args))
                        else  ((t6_C.elem_C args + 1), (t6_C.acc_C args)))"
definition m_n
  where
  "m_n = (\<lambda>n a1 a2 a3. map_dispatch (sint n) (t6_C a2 a1 a3))"

lemma map_loop:
  "\<lbrace>\<lambda>s.  b = y \<and> y < ret \<and> ret = min to (w_l s w) \<and> (frm \<le> ret \<longrightarrow> y \<le> ret) \<and>
    (ret < frm \<longrightarrow> frm = y) \<and> frm \<le> y \<and>
    \<alpha> s (fst (w_map xs (unat frm) (unat y) (m_n m_num) acc obsv)) w  \<and>
    xd = t6_C.elem_C_update (\<lambda>a. heap_w32 s ((w_p s w) +\<^sub>p uint y)) xa  \<and>
    (t6_C.acc_C xd) = snd (w_map xs (unat frm) (unat y) (m_n m_num) acc obsv) \<rbrace>
    dispatch_t8' (sint n_num) xd
   \<lbrace>\<lambda>xe s.
    \<alpha> (heap_w32_update (\<lambda>a b. if b = values_C (heap_WordArray_u32_C s w) +\<^sub>p uint y then t7_C.p1_C xe else a b) s)
      (fst (w_map xs (unat frm) (unat (y + 1)) (m_n m_num) acc obsv)) w \<and>
    t7_C.p2_C xe = snd (w_map xs (unat frm) (unat (y + 1)) (m_n m_num) acc obsv) \<and>
    ret = min to (len_C (heap_WordArray_u32_C s w)) \<and>
    (frm \<le> ret \<longrightarrow> y + 1 \<le> ret) \<and> (ret < frm \<longrightarrow> frm = y + 1) \<and> frm \<le> y + 1 \<and>
    min (unat to) (length xs) - unat (y + 1) < min (unat to) (length xs) - unat b \<and>
    is_valid_w32 s (values_C (heap_WordArray_u32_C s w) +\<^sub>p uint y) \<and> is_valid_WordArray_u32_C s w\<rbrace>!"
  apply (unfold dispatch_t8'_def inc'_def)
  apply wp
  apply clarsimp
  apply (rule conjI)
   apply (subst unatSuc2)
  using less_is_non_zero_p1 apply fastforce
   apply (simp (no_asm) add: \<alpha>_def)
   apply (clarsimp simp add: u32list_all_nth)
   apply (rule conjI)
    apply clarsimp
    apply (rule conjI)
     apply clarsimp
     apply (rule conjI)
      apply (simp add: \<alpha>_def)
      apply (metis u32list_all_nth w_map_length)
     apply (subgoal_tac "uint y = int k")
      apply (subst w_map_step)
  using word_le_nat_alt apply blast
      apply (subgoal_tac "k = unat y")
       apply simp
       apply (subst  nth_list_update_eq)
        apply (simp add: w_map_length)
       apply (simp add: m_n_def)
       apply (simp add: \<alpha>_nth(1) w_map_endpoint w_map_length)
      apply (metis int_unat nat_int.Rep_eqD)
     apply (clarsimp simp add: uint_nat word_less_nat_alt abs_length_eq w_map_length[symmetric])
     apply (metis wordarray_same_address w_map_length_same)
    apply clarsimp
    apply (rule conjI)
     apply (simp add: \<alpha>_def u32list_all_nth w_map_length)
    apply (subst w_map_step)
  using word_le_nat_alt apply blast
    apply (subgoal_tac "k \<noteq> unat y")
     apply (simp add: \<alpha>_nth(1) w_map_length)
    apply (metis int_unat)
   apply (rule conjI)
    apply (simp add: \<alpha>_def u32list_all_nth w_map_length)
   apply (simp add: \<alpha>_def u32list_all_nth w_map_length)
  apply (rule conjI)
   apply (subst unatSuc2)
  using less_is_non_zero_p1 apply fastforce
   apply (subst w_map_step)
  using word_le_nat_alt apply blast
    apply (metis Suc_le_eq abs_length_eq w_map_length unat_mono)
   apply (simp add: m_n_def)
  apply (rule conjI)
   apply clarsimp
  using inc_le apply blast
  apply (rule conjI)
   apply clarsimp
   apply (meson min_less_iff_conj not_less_iff_gr_or_eq)
  apply (rule conjI)
   apply (metis (mono_tags, hide_lams) add.commute less_is_non_zero_p1  min.strict_coboundedI2 min_def  word_le_less_eq word_overflow)
  apply (rule conjI)
   apply (subgoal_tac "length xs > unat y")
    apply (subgoal_tac "unat to > unat y")
     apply (meson diff_less_mono2 less_is_non_zero_p1 min_less_iff_conj word_less_nat_alt word_overflow)
  using unat_mono apply blast
   apply (simp add: abs_length_eq w_map_length word_less_nat_alt)
  apply (rule conjI)
   apply (subgoal_tac "unat y < length xs")
    apply (simp add: \<alpha>_nth(2) w_map_length uint_nat)
   apply (simp add: abs_length_eq w_map_length word_less_nat_alt)
  apply (simp add: \<alpha>_def)
  done

lemma wordarray_map_refinement:
  "\<lbrace>\<lambda>s. \<alpha> s xs w \<rbrace>
   wordarray_map_no_break_0' (t9_C acc w n_num frm obsv to)
   \<lbrace>\<lambda>r s. \<alpha> s (fst (w_map xs (unat frm) (unat to) (m_n m_num) acc obsv)) w \<and>
    (t10_C.p2_C r) = snd (w_map xs (unat frm) (unat to) (m_n m_num) acc obsv)\<rbrace>!"
  unfolding wordarray_map_no_break_0'_def
  apply wp
        apply(subst whileLoop_add_inv[where I ="\<lambda>(fargs, i) s.
                              \<alpha> s (fst (w_map xs (unat frm) (unat i) (m_n m_num) acc obsv)) w \<and>
                              (t6_C.acc_C fargs) = snd (w_map xs (unat frm) (unat i) (m_n m_num) acc obsv) \<and>
                              ret = min to (w_l s w) \<and> (frm \<le> ret  \<longrightarrow> i \<le> ret) \<and> (frm > ret \<longrightarrow> frm = i) \<and> frm \<le> i"
                              and
                              M = "\<lambda>((fargs, i), s). (min (unat to) (length xs)) -  unat i"])
       apply wp
            apply clarsimp
            apply (wp map_loop)
           apply wp
          apply wp
         apply wp
        apply clarsimp
        apply (rule conjI)
         apply simp
        apply (metis (full_types) \<alpha>_def int_unat u32list_all_nth w_length_def word_less_nat_alt)
       apply clarsimp

       apply (case_tac "min to (len_C (heap_WordArray_u32_C s w)) < frm")
        apply (case_tac "b > to")
         apply (clarsimp simp add: w_map_def)
         apply (rule FalseE)
         apply (simp add: dual_order.strict_implies_order unat_mono)
        apply clarsimp
        apply (subgoal_tac "unat frm > length xs")
         apply (simp add: w_map_def)
        apply (metis (mono_tags, hide_lams) abs_length_eq w_map_length min_less_iff_disj unat_mono)
       apply clarsimp
       apply (subgoal_tac "frm \<le> to \<and> frm \<le> len_C (heap_WordArray_u32_C s w)")
        apply clarsimp
        apply (case_tac "b = to")
         apply simp
        apply (subgoal_tac "b < to")
         apply clarsimp
         apply (metis abs_length_eq w_map_bounds w_map_length word_le_nat_alt)
  using word_le_less_eq apply blast
       apply (simp add: min_less_iff_disj word_le_not_less)
      apply wp
     apply wp
    apply wp
   apply wp
  apply clarsimp
  apply (simp add: w_map_def)
  apply (rule conjI)
   apply (simp add: min.commute min.strict_order_iff)
  apply (simp add: \<alpha>_def)
  using min.strict_order_iff apply fastforce
  done

end
end


section {*FUNCTION\_\_F\_EPDA\_RS\_\_EPDA\_RESTRICT\_STATES*}
theory
  FUNCTION__F_EPDA_RS__EPDA_RESTRICT_STATES

imports
  PRJ_12_04_01_03__ENTRY

begin

definition F_ALT_EPDA_RS :: "
  ('state, 'event, 'stack) epda
  \<Rightarrow> 'state set
  \<Rightarrow> ('state, 'event, 'stack) epda option"
  where
    "F_ALT_EPDA_RS G Q \<equiv>
  if epda_initial G \<notin> Q
  then None
  else Some
        \<lparr>epda_states = Q,
        epda_events = epda_events G,
        epda_gamma = epda_gamma G,
        epda_delta = {e. e \<in> epda_delta G \<and> edge_src e \<in> Q \<and> edge_trg e \<in> Q},
        epda_initial = epda_initial G,
        epda_box = epda_box G,
        epda_marking = epda_marking G \<inter> Q\<rparr>"

lemma F_EPDA_RS__vs_F_ALT_EPDA_RS: "
  valid_epda G
  \<Longrightarrow> Q \<subseteq> epda_states G
  \<Longrightarrow> F_ALT_EPDA_RS G Q = F_EPDA_RS G Q"
  apply(simp add: F_ALT_EPDA_RS_def F_EPDA_RS_def F_EPDA_R_def)
  apply(clarsimp)
  apply(rule conjI)
   apply(force)
  apply(force)
  done

definition retain_edges_between_retained_states :: "
  ('state, 'event, 'stack) epda
  \<Rightarrow> 'state set
  \<Rightarrow> ('state, 'event, 'stack) epda
  \<Rightarrow> bool"
  where
    "retain_edges_between_retained_states Gi Q Go \<equiv>
  \<forall>e \<in> epda_delta Gi.
    edge_src e \<in> Q
    \<longrightarrow> edge_trg e \<in> Q
    \<longrightarrow> e \<in> epda_delta Go"

definition F_EPDA_RS__SpecInput :: "
  ('state, 'event, 'stack) epda
  \<Rightarrow> 'state set
  \<Rightarrow> bool"
  where
    "F_EPDA_RS__SpecInput G Q \<equiv>
  valid_dpda G
  \<and> Q \<subseteq> epda_states G
  \<and> \<not> epdaH_livelock G
  \<and> nonblockingness_language (epdaH.unmarked_language G) (epdaH.marked_language G)
  \<and> only_executing_edges_from_marking_states G
  \<and> epdaH.accessible G"

definition F_EPDA_RS__SpecOutput :: "
  ('state, 'event, 'stack) epda
  \<Rightarrow> 'state set
  \<Rightarrow> ('state, 'event, 'stack) epda option
  \<Rightarrow> bool"
  where
    "F_EPDA_RS__SpecOutput Gi Q Go \<equiv>
  case Go of
    None \<Rightarrow>
        epda_initial Gi \<notin> Q
    | Some Go \<Rightarrow>
        valid_dpda Go
        \<and> \<not> epdaH_livelock Go
        \<and> (Q = epda_states Gi \<longleftrightarrow> Gi = Go)
        \<and> (Q = epda_states Gi \<longleftrightarrow> epda_to_des Gi = epda_to_des Go)
        \<and> retain_edges_between_retained_states Gi Q Go"

lemma F_ALT_EPDA_RS__preserves_valid_pda: "
  valid_pda G
  \<Longrightarrow> Q \<subseteq> epda_states G
  \<Longrightarrow> F_ALT_EPDA_RS G Q = Some G'
  \<Longrightarrow> valid_pda G'"
  apply(simp add: valid_pda_def valid_dpda_def valid_epda_def F_ALT_EPDA_RS_def)
  apply(clarsimp)
  apply(case_tac "epda_initial G \<notin> Q")
   apply(clarsimp)
  apply(clarsimp)
  apply(rule conjI)
   apply(rule_tac
      B="epda_states G"
      in finite_subset)
    apply(force)
   apply(force)
  apply(clarsimp)
  apply(rename_tac x)(*strict*)
  apply(erule_tac
      x="x"
      and P="\<lambda>x. valid_epda_step_label G x"
      in ballE)
   apply(rename_tac x)(*strict*)
   prefer 2
   apply(force)
  apply(rename_tac x)(*strict*)
  apply(simp add: valid_epda_step_label_def)
  done

lemma F_ALT_EPDA_RS__preserves_valid_dpda: "
  valid_dpda G
  \<Longrightarrow> Q \<subseteq> epda_states G
  \<Longrightarrow> F_ALT_EPDA_RS G Q = Some G'
  \<Longrightarrow> valid_dpda G'"
  apply(simp add: valid_dpda_def)
  apply(rule context_conjI)
   apply(rule F_ALT_EPDA_RS__preserves_valid_pda)
     prefer 3
     apply(force)
    apply(force)
   apply(force)
  apply(rule_tac
      G="G"
      and G'="G'"
      in epda_sub_preserves_is_forward_edge_deterministic_accessible)
    apply(simp add: valid_dpda_def)
   apply(force)
  apply(simp add: epda_sub_def F_ALT_EPDA_RS_def)
  apply(clarsimp)
  apply(case_tac "epda_initial G \<notin> Q")
   apply(force)
  apply(force)
  done

lemma F_ALT_EPDA_RS__preserves_no_epda_livelock: "
  valid_dpda G
  \<Longrightarrow> Q \<subseteq> epda_states G
  \<Longrightarrow> F_ALT_EPDA_RS G Q = Some G'
  \<Longrightarrow> valid_dpda G'
  \<Longrightarrow> \<not> epdaH_livelock G
  \<Longrightarrow> \<not> epdaH_livelock G'"
  apply(simp add: epdaH_livelock_def)
  apply(clarsimp)
  apply(rename_tac d N)(*strict*)
  apply(erule_tac
      x="d"
      in allE)
  apply(erule impE)
   apply(rename_tac d N)(*strict*)
   apply(rule_tac
      ?G1.0="G'"
      in epda_sub_preserves_derivation_initial)
      apply(rename_tac d N)(*strict*)
      apply(simp add: valid_dpda_def valid_pda_def)
     apply(rename_tac d N)(*strict*)
     apply(simp add: valid_dpda_def valid_pda_def)
    apply(rename_tac d N)(*strict*)
    apply(simp add: epda_sub_def F_ALT_EPDA_RS_def)
    apply(rename_tac d)(*strict*)
    apply(case_tac "epda_initial G \<notin> Q")
     apply(rename_tac d)(*strict*)
     apply(force)
    apply(rename_tac d)(*strict*)
    apply(force)
   apply(rename_tac d N)(*strict*)
   apply(force)
  apply(rename_tac d N)(*strict*)
  apply(erule disjE)
   apply(rename_tac d N)(*strict*)
   apply(clarsimp)
   apply(rename_tac d N n)(*strict*)
   apply(erule_tac
      x="n"
      in allE)
   apply(force)
  apply(rename_tac d N)(*strict*)
  apply(clarsimp)
  done

lemma F_ALT_EPDA_RS__no_modification: "
  valid_dpda G
  \<Longrightarrow> Q \<subseteq> epda_states G
  \<Longrightarrow> F_ALT_EPDA_RS G Q = Some G'
  \<Longrightarrow> valid_dpda G'
  \<Longrightarrow> (Q = epda_states G) = (G = G')"
  apply(rule order_antisym)
   apply(simp add: F_ALT_EPDA_RS_def)
   apply(case_tac "epda_initial G \<notin> Q")
    apply(clarsimp)
   apply(clarsimp)
   apply(case_tac G)
   apply(rename_tac epda_statesa epda_eventsa epda_gammaa epda_deltaa epda_initiala epda_boxa epda_markinga)(*strict*)
   apply(clarsimp)
   apply(rename_tac epda_states epda_events epda_gamma epda_delta epda_initial epda_box epda_marking)(*strict*)
   apply(rule conjI)
    apply(rename_tac epda_states epda_events epda_gamma epda_delta epda_initial epda_box epda_marking)(*strict*)
    apply(rule order_antisym)
     apply(rename_tac epda_states epda_events epda_gamma epda_delta epda_initial epda_box epda_marking)(*strict*)
     apply(clarsimp)
     apply(rename_tac epda_states epda_events epda_gamma epda_delta epda_initial epda_box epda_marking x)(*strict*)
     apply(simp add: valid_dpda_def valid_pda_def valid_epda_def)
     apply(clarsimp)
     apply(erule_tac
      x="x"
      and P="\<lambda>x. valid_epda_step_label \<lparr>epda_states = epda_states, epda_events = epda_events, epda_gamma = epda_gamma, epda_delta = epda_delta, epda_initial = epda_initial, epda_box = epda_box, epda_marking = epda_marking\<rparr> x"
      in ballE)
      apply(rename_tac epda_states epda_events epda_gamma epda_delta epda_initial epda_box epda_marking x)(*strict*)
      prefer 2
      apply(force)
     apply(rename_tac epda_states epda_events epda_gamma epda_delta epda_initial epda_box epda_marking x)(*strict*)
     apply(simp add: valid_epda_step_label_def)
    apply(rename_tac epda_states epda_events epda_gamma epda_delta epda_initial epda_box epda_marking)(*strict*)
    apply(clarsimp)
   apply(rename_tac epda_states epda_events epda_gamma epda_delta epda_initial epda_box epda_marking)(*strict*)
   apply(simp add: valid_dpda_def valid_pda_def valid_epda_def)
   apply(force)
  apply(simp add: F_ALT_EPDA_RS_def)
  apply(clarsimp)
  apply(rename_tac x)(*strict*)
  apply(case_tac "epda_initial G' \<notin> Q")
   apply(rename_tac x)(*strict*)
   apply(clarsimp)
  apply(rename_tac x)(*strict*)
  apply(clarsimp)
  apply(case_tac G')
  apply(rename_tac x epda_statesa epda_eventsa epda_gammaa epda_deltaa epda_initiala epda_boxa epda_markinga)(*strict*)
  apply(clarsimp)
  done

lemma F_ALT_EPDA_RS__lang_modification: "
  valid_dpda G
  \<Longrightarrow> Q \<subseteq> epda_states G
  \<Longrightarrow> \<not> epdaH_livelock G
  \<Longrightarrow> epdaH.accessible G
  \<Longrightarrow> F_ALT_EPDA_RS G Q = Some G'
  \<Longrightarrow> nonblockingness_language (epdaH.unmarked_language G) (epdaH.marked_language G)
  \<Longrightarrow> only_executing_edges_from_marking_states G
  \<Longrightarrow> valid_dpda G'
  \<Longrightarrow> (epda_to_des G = epda_to_des G') \<le> (Q = epda_states G)"
  (*nonambiguous (epdaS/epdaHS or almost epdaH (consider continuations))
accessible
Nonblockingness
\<Longrightarrow> removal of a state changes the marked language
*)
  apply(clarsimp)
  apply(rename_tac x)(*strict*)
  apply(simp add: epda_to_des_def)
  apply(clarsimp)
  apply(simp add: epdaH.accessible_def)
  apply(simp add: epda_destinations_def)
  apply(clarsimp)
  apply(thin_tac "edge ` epda_delta G \<subseteq> epdaH.get_accessible_destinations G")
  apply(rename_tac x)(*strict*)
  apply(subgoal_tac "epda_destinations.state x \<in> epdaH.get_accessible_destinations G")
   apply(rename_tac x)(*strict*)
   prefer 2
   apply(force)
  apply(rename_tac x)(*strict*)
  apply(thin_tac "epda_destinations.state ` epda_states G \<subseteq> epdaH.get_accessible_destinations G")
  apply(rename_tac x)(*strict*)
  apply(simp add: epdaH.get_accessible_destinations_def)
  apply(clarsimp)
  apply(rename_tac x d i e c)(*strict*)
  apply(simp add: epdaH_get_destinations_def)
  apply(case_tac c)
  apply(rename_tac x d i e c epdaH_conf_statea epdaH_conf_history epdaH_conf_stack)(*strict*)
  apply(clarsimp)
  apply(rename_tac x d i e epdaH_conf_state epdaH_conf_history epdaH_conf_stack)(*strict*)
  apply(rename_tac q h s)
  apply(rename_tac x d i e q h s)(*strict*)
  apply(erule disjE)
   apply(rename_tac x d i e q h s)(*strict*)
   prefer 2
   apply(case_tac e)
    apply(rename_tac x d i e q h s)(*strict*)
    apply(clarsimp)
   apply(rename_tac x d i e q h s a)(*strict*)
   apply(clarsimp)
  apply(rename_tac x d i e q h s)(*strict*)
  apply(clarsimp)
  apply(rename_tac d i e q h s)(*strict*)
  apply(subgoal_tac "h \<in> epdaH.unmarked_language G")
   apply(rename_tac d i e q h s)(*strict*)
   prefer 2
   apply(thin_tac "epdaH.unmarked_language G = epdaH.unmarked_language G'")
   apply(simp add: epdaH.unmarked_language_def)
   apply(rule_tac
      x="d"
      in exI)
   apply(clarsimp)
   apply(rule conjI)
    apply(rename_tac d i e q h s)(*strict*)
    apply(simp add: epdaH_unmarked_effect_def)
    apply(rule_tac
      x="i"
      in exI)
    apply(clarsimp)
   apply(rename_tac d i e q h s)(*strict*)
   apply(simp add: epdaH.derivation_initial_def)
  apply(rename_tac d i e q h s)(*strict*)
  apply(subgoal_tac "\<exists>h'. h@h' \<in> epdaH.marked_language G")
   apply(rename_tac d i e q h s)(*strict*)
   prefer 2
   apply(simp add: nonblockingness_language_def prefix_closure_def prefix_def)
   apply(force)
  apply(rename_tac d i e q h s)(*strict*)
  apply(erule exE)+
  apply(rename_tac d i e q h s h')(*strict*)
  apply(rule ccontr)
  apply(subgoal_tac "h@h' \<notin> epdaH.marked_language G'")
   apply(rename_tac d i e q h s h')(*strict*)
   apply(force)
  apply(rename_tac d i e q h s h')(*strict*)
  apply(thin_tac "epdaH.marked_language G = epdaH.marked_language G'")
  apply(thin_tac "epdaH.unmarked_language G = epdaH.unmarked_language G'")
  apply(thin_tac "h \<in> epdaH.unmarked_language G")
  apply(thin_tac "epda_destinations.state q \<in> epda_destinations G")
  apply(thin_tac "q \<in> epda_states G")
  apply(rename_tac d i e q h s h')(*strict*)
  apply(simp add: epdaH.marked_language_def)
  apply(clarsimp)
  apply(rename_tac d i e q h s h' da db)(*strict*)
  apply(thin_tac "epdaH_marking_condition G' db")
  apply(thin_tac "epdaH_marking_condition G da")
  apply(thin_tac "epdaH.derivation G da")
  apply(thin_tac "epdaH.derivation G' db")
  apply(thin_tac "nonblockingness_language (epdaH.unmarked_language G') {w. \<exists>d. epdaH.derivation_initial G' d \<and> w \<in> epdaH_marked_effect G' d \<and> epdaH.derivation G' d \<and> epdaH_marking_condition G' d}")
  apply(rename_tac d i e q h s h' da db)(*strict*)
  apply(simp add: epdaH_marked_effect_def)
  apply(clarsimp)
  apply(rename_tac d i e q h s h' da db ia ib ea eb c ca)(*strict*)
  apply(simp add: epdaH_marking_configurations_def)
  apply(clarsimp)
  apply(case_tac ca)
  apply(rename_tac d i e q h s h' da db ia ib ea eb c ca epdaH_conf_statea epdaH_conf_historya epdaH_conf_stack)(*strict*)
  apply(case_tac c)
  apply(rename_tac d i e q h s h' da db ia ib ea eb c ca epdaH_conf_statea epdaH_conf_historya epdaH_conf_stack epdaH_conf_stateaa epdaH_conf_historyaa epdaH_conf_stacka)(*strict*)
  apply(clarsimp)
  apply(rename_tac d i e q h s h' da db ia ib ea eb epdaH_conf_state epdaH_conf_stack epdaH_conf_statea epdaH_conf_stacka)(*strict*)
  apply(rename_tac q1 s1 q2 s2)
  apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
  apply(thin_tac "\<lparr>epdaH_conf_state = q1, epdaH_conf_history = h @ h', epdaH_conf_stack = s1\<rparr> \<in> epdaH_configurations G'")
  apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
  apply(thin_tac "\<lparr>epdaH_conf_state = q2, epdaH_conf_history = h @ h', epdaH_conf_stack = s2\<rparr> \<in> epdaH_configurations G")
  apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
  apply(thin_tac "\<forall>j e' c'. ia < j \<and> da j = Some (pair e' c') \<longrightarrow> epdaH_string_state \<lparr>epdaH_conf_state = q2, epdaH_conf_history = h @ h', epdaH_conf_stack = s2\<rparr> = epdaH_string_state c'")
  apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
  apply(thin_tac "\<forall>j e' c'. ib < j \<and> db j = Some (pair e' c') \<longrightarrow> epdaH_string_state \<lparr>epdaH_conf_state = q1, epdaH_conf_history = h @ h', epdaH_conf_stack = s1\<rparr> = epdaH_string_state c'")
  apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
  apply(subgoal_tac "X" for X)
   apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
   prefer 2
   apply(rule_tac
      G="G"
      in DPDA_only_executing_edges_from_marking_states_implies_epdaH_non_ambiguous)
    apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
    apply(force)
   apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
   apply(force)
  apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
  apply(simp add: epdaH_non_ambiguous_def)
  apply(erule_tac
      x="da"
      in allE)
  apply(erule impE)
   apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
   apply(force)
  apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
  apply(erule_tac
      x="db"
      in allE)
  apply(erule impE)
   apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
   apply(rule_tac
      ?G1.0="G'"
      in epda_sub_preserves_derivation_initial)
      apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
      apply(simp add: valid_dpda_def valid_pda_def)
     apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
     apply(simp add: valid_dpda_def valid_pda_def)
    apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
    prefer 2
    apply(force)
   apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
   apply(simp add: epda_sub_def F_ALT_EPDA_RS_def)
   apply(case_tac "epda_initial G \<notin> Q")
    apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
    apply(clarsimp)
   apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
   apply(clarsimp)
  apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
  apply(erule_tac
      x="ia"
      in allE)
  apply(erule_tac
      x="ib"
      in allE)
  apply(clarsimp)
  apply(simp add: get_configuration_def)
  apply(erule impE)
   apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
   apply(simp add: epda_sub_def F_ALT_EPDA_RS_def)
   apply(case_tac "epda_initial G \<notin> Q")
    apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
    apply(clarsimp)
   apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
   apply(clarsimp)
  apply(rename_tac d i e q h s h' da db ia ib ea eb q1 s1 q2 s2)(*strict*)
  apply(clarsimp)
    (*
d is a prefix of da = db
thus d!i=db!i \<Longrightarrow> q \<in> Q
*)
  apply(rename_tac d i e q h s h' da db ib ea q2 s2)(*strict*)
  apply(case_tac "ib<i")
   apply(rename_tac d i e q h s h' da db ib ea q2 s2)(*strict*)
   apply(subgoal_tac "X" for X)
    apply(rename_tac d i e q h s h' da db ib ea q2 s2)(*strict*)
    prefer 2
    apply(rule_tac
      g="d"
      and n="ib"
      and m="i"
      in epdaH.pre_some_position_is_some_position)
      apply(rename_tac d i e q h s h' da db ib ea q2 s2)(*strict*)
      apply(simp add: epdaH.derivation_initial_def)
      apply(force)
     apply(rename_tac d i e q h s h' da db ib ea q2 s2)(*strict*)
     apply(force)
    apply(rename_tac d i e q h s h' da db ib ea q2 s2)(*strict*)
    apply(force)
   apply(rename_tac d i e q h s h' da db ib ea q2 s2)(*strict*)
   apply(clarsimp)
   apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb c)(*strict*)
   apply(subgoal_tac "X" for X)
    apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb c)(*strict*)
    prefer 2
    apply(rule_tac
      G="G"
      and d="d"
      and n="ib"
      and m="i-ib"
      in epdaH.steps_extend_history_derivation)
        apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb c)(*strict*)
        apply(simp add: valid_dpda_def valid_pda_def)
       apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb c)(*strict*)
       apply(simp add: epdaH.derivation_initial_def)
      apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb c)(*strict*)
      prefer 2
      apply(clarsimp)
      apply(simp add: get_configuration_def)
     apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb c)(*strict*)
     apply(rule_tac
      d="d"
      in epdaH.belongs_configurations)
      apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb c)(*strict*)
      apply(rule epdaH.derivation_initial_belongs)
       apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb c)(*strict*)
       apply(simp add: valid_dpda_def valid_pda_def)
      apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb c)(*strict*)
      apply(force)
     apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb c)(*strict*)
     apply(force)
    apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb c)(*strict*)
    apply(simp add: get_configuration_def)
   apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb c)(*strict*)
   apply(clarsimp)
   apply(rename_tac d i e q s h' da db ib ea q2 s2 eb c ha)(*strict*)
   apply(case_tac c)
   apply(rename_tac d i e q s h' da db ib ea q2 s2 eb c ha epdaH_conf_state epdaH_conf_historya epdaH_conf_stack)(*strict*)
   apply(rename_tac q1 h1 s1)
   apply(rename_tac d i e q s h' da db ib ea q2 s2 eb c ha q1 h1 s1)(*strict*)
   apply(clarsimp)
   apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
   apply(subgoal_tac "X" for X)
    apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
    prefer 2
    apply(rule_tac
      G="G"
      and ?d1.0="d"
      and ?d2.0="da"
      and x="0"
      and y="0"
      and n="ib"
      and m="ib"
      in epdaH.is_forward_deterministicHist_derivations_coincide)
               apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
               apply(simp add: valid_dpda_def valid_pda_def)
              apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
              apply(force)
             apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
             apply(force)
            apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
            apply (metis DPDA_is_is_forward_deterministicHist_SB)
           apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
           apply(simp add: epdaH.derivation_initial_def)
           apply(erule_tac
      x="0"
      in allE)
           apply(clarsimp)
           apply(case_tac "db 0")
            apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
            apply(clarsimp)
           apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1 a)(*strict*)
           apply(clarsimp)
           apply(case_tac a)
           apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1 a option b)(*strict*)
           apply(clarsimp)
           apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1 b)(*strict*)
           apply(simp add: epdaH_initial_configurations_def)
           apply(clarsimp)
           apply(case_tac "d 0")
            apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1 b)(*strict*)
            apply(clarsimp)
           apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1 b a)(*strict*)
           apply(clarsimp)
           apply(case_tac a)
           apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1 b a option ba)(*strict*)
           apply(clarsimp)
           apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1 b ba)(*strict*)
           apply(simp add: epdaH_initial_configurations_def)
          apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
          apply(force)
         apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
         apply(force)
        apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
        apply(force)
       apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
       apply(force)
      apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
      apply(force)
     apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
     apply(clarsimp)
     apply(simp add: epda_effects_def)
     apply(simp add: get_configuration_def)
     apply(subgoal_tac "\<lparr>epdaH_conf_state = q2, epdaH_conf_history = h1 @ ha @ h', epdaH_conf_stack = s2\<rparr> \<in> epdaH_configurations G")
      apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
      apply(simp add: epdaH_configurations_def)
     apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
     apply(rule_tac
      d="da"
      in epdaH.belongs_configurations)
      apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
      apply(rule epdaH.derivation_initial_belongs)
       apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
       apply(simp add: valid_dpda_def valid_pda_def)
      apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
      apply(force)
     apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
     apply(force)
    apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
    apply(force)
   apply(rename_tac d i e q s h' da db ib ea q2 s2 eb ha q1 h1 s1)(*strict*)
   apply(clarsimp)
   apply(rename_tac d i e q s da db ib ea q2 s2 h1)(*strict*)
   apply(subgoal_tac "X" for X)
    apply(rename_tac d i e q s da db ib ea q2 s2 h1)(*strict*)
    prefer 2
    apply(rule_tac
      d="d"
      and n="ib"
      and m="i"
      and G="G"
      in epdaH.step_detail_before_some_position)
      apply(rename_tac d i e q s da db ib ea q2 s2 h1)(*strict*)
      apply(simp add: epdaH.derivation_initial_def)
     apply(rename_tac d i e q s da db ib ea q2 s2 h1)(*strict*)
     apply(force)
    apply(rename_tac d i e q s da db ib ea q2 s2 h1)(*strict*)
    apply(force)
   apply(rename_tac d i e q s da db ib ea q2 s2 h1)(*strict*)
   apply(clarsimp)
   apply(rename_tac d i e q s da db ib ea q2 s2 h1 e2 c2)(*strict*)
   apply(simp add: epdaH_step_relation_def)
   apply(clarsimp)
   apply(rename_tac d i e q s da db ib ea h1 e2 c2 w)(*strict*)
   apply(case_tac c2)
   apply(rename_tac d i e q s da db ib ea h1 e2 c2 w epdaH_conf_statea epdaH_conf_historya epdaH_conf_stacka)(*strict*)
   apply(clarsimp)
   apply(rename_tac d i e q s da db ib ea h1 e2 w)(*strict*)
   apply(subgoal_tac "X" for X)
    apply(rename_tac d i e q s da db ib ea h1 e2 w)(*strict*)
    prefer 2
    apply(rule_tac
      d="d"
      and G="G"
      and n="Suc ib"
      and m="i-Suc ib"
      in epdaH.steps_extend_history_derivation)
        apply(rename_tac d i e q s da db ib ea h1 e2 w)(*strict*)
        apply(simp add: valid_dpda_def valid_pda_def)
       apply(rename_tac d i e q s da db ib ea h1 e2 w)(*strict*)
       apply(simp add: epdaH.derivation_initial_def)
      apply(rename_tac d i e q s da db ib ea h1 e2 w)(*strict*)
      prefer 2
      apply(clarsimp)
      apply(simp add: get_configuration_def)
     apply(rename_tac d i e q s da db ib ea h1 e2 w)(*strict*)
     apply(rule_tac
      d="d"
      in epdaH.belongs_configurations)
      apply(rename_tac d i e q s da db ib ea h1 e2 w)(*strict*)
      apply(rule epdaH.derivation_initial_belongs)
       apply(rename_tac d i e q s da db ib ea h1 e2 w)(*strict*)
       apply(simp add: valid_dpda_def valid_pda_def)
      apply(rename_tac d i e q s da db ib ea h1 e2 w)(*strict*)
      apply(force)
     apply(rename_tac d i e q s da db ib ea h1 e2 w)(*strict*)
     apply(force)
    apply(rename_tac d i e q s da db ib ea h1 e2 w)(*strict*)
    apply(simp add: get_configuration_def)
   apply(rename_tac d i e q s da db ib ea h1 e2 w)(*strict*)
   apply(clarsimp)
   apply(simp add: option_to_list_def)
   apply(case_tac "edge_event e2")
    apply(rename_tac d i e q s da db ib ea h1 e2 w)(*strict*)
    apply(clarsimp)
    apply(simp add: only_executing_edges_from_marking_states_def)
   apply(rename_tac d i e q s da db ib ea h1 e2 w a)(*strict*)
   apply(clarsimp)
  apply(rename_tac d i e q h s h' da db ib ea q2 s2)(*strict*)
  apply(case_tac "i<ib")
   apply(rename_tac d i e q h s h' da db ib ea q2 s2)(*strict*)
   apply(thin_tac "\<not> ib < i")
   apply(subgoal_tac "X" for X)
    apply(rename_tac d i e q h s h' da db ib ea q2 s2)(*strict*)
    prefer 2
    apply(rule_tac
      g="da"
      and n="i"
      and m="ib"
      in epdaH.pre_some_position_is_some_position)
      apply(rename_tac d i e q h s h' da db ib ea q2 s2)(*strict*)
      apply(simp add: epdaH.derivation_initial_def)
      apply(force)
     apply(rename_tac d i e q h s h' da db ib ea q2 s2)(*strict*)
     apply(force)
    apply(rename_tac d i e q h s h' da db ib ea q2 s2)(*strict*)
    apply(force)
   apply(rename_tac d i e q h s h' da db ib ea q2 s2)(*strict*)
   apply(clarsimp)
   apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb c)(*strict*)
   apply(case_tac c)
   apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb c epdaH_conf_state epdaH_conf_history epdaH_conf_stack)(*strict*)
   apply(rename_tac q1 h1 s1)
   apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb c q1 h1 s1)(*strict*)
   apply(clarsimp)
   apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb q1 h1 s1)(*strict*)
   apply(subgoal_tac "X" for X)
    apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb q1 h1 s1)(*strict*)
    prefer 2
    apply(rule_tac
      G="G"
      and d="da"
      and n="i"
      and m="ib-i"
      in epdaH.steps_extend_history_derivation)
        apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb q1 h1 s1)(*strict*)
        apply(simp add: valid_dpda_def valid_pda_def)
       apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb q1 h1 s1)(*strict*)
       apply(simp add: epdaH.derivation_initial_def)
      apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb q1 h1 s1)(*strict*)
      prefer 2
      apply(clarsimp)
      apply(simp add: get_configuration_def)
     apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb q1 h1 s1)(*strict*)
     apply(rule_tac
      d="da"
      in epdaH.belongs_configurations)
      apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb q1 h1 s1)(*strict*)
      apply(rule epdaH.derivation_initial_belongs)
       apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb q1 h1 s1)(*strict*)
       apply(simp add: valid_dpda_def valid_pda_def)
      apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb q1 h1 s1)(*strict*)
      apply(force)
     apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb q1 h1 s1)(*strict*)
     apply(erule_tac
      x="i"
      in allE)
     apply(force)
    apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb q1 h1 s1)(*strict*)
    apply(simp add: get_configuration_def)
   apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb q1 h1 s1)(*strict*)
   apply(clarsimp)
   apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb q1 h1 s1 ha)(*strict*)
   apply(subgoal_tac "prefix h h1 \<or> prefix h1 h")
    apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb q1 h1 s1 ha)(*strict*)
    prefer 2
    apply(rule mutual_prefix_prefix)
    apply(force)
   apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb q1 h1 s1 ha)(*strict*)
   apply(erule disjE)
    apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb q1 h1 s1 ha)(*strict*)
    apply(simp add: prefix_def)
    apply(clarsimp)
    apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
    apply(subgoal_tac "X" for X)
     apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
     prefer 2
     apply(rule_tac
      G="G"
      and ?d1.0="d"
      and ?d2.0="da"
      and x="0"
      and y="0"
      and n="i"
      and m="i"
      in epdaH.is_forward_deterministicHist_derivations_coincide)
                apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
                apply(simp add: valid_dpda_def valid_pda_def)
               apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
               apply(force)
              apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
              apply(force)
             apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
             apply (metis DPDA_is_is_forward_deterministicHist_SB)
            apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
            apply(simp add: epdaH.derivation_initial_def)
            apply(erule_tac
      x="0"
      in allE)
            apply(clarsimp)
            apply(case_tac "db 0")
             apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
             apply(clarsimp)
            apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c a)(*strict*)
            apply(clarsimp)
            apply(case_tac a)
            apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c a option b)(*strict*)
            apply(clarsimp)
            apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c b)(*strict*)
            apply(simp add: epdaH_initial_configurations_def)
            apply(clarsimp)
            apply(case_tac "d 0")
             apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c b)(*strict*)
             apply(clarsimp)
            apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c b a)(*strict*)
            apply(clarsimp)
            apply(case_tac a)
            apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c b a option ba)(*strict*)
            apply(clarsimp)
            apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c b ba)(*strict*)
            apply(simp add: epdaH_initial_configurations_def)
           apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
           apply(force)
          apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
          apply(force)
         apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
         apply(force)
        apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
        apply(force)
       apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
       apply(force)
      apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
      apply(clarsimp)
      apply(simp add: epda_effects_def)
      apply(simp add: get_configuration_def)
      apply(subgoal_tac "\<lparr>epdaH_conf_state = q2, epdaH_conf_history = h @ c @ ha, epdaH_conf_stack = s2\<rparr> \<in> epdaH_configurations G")
       apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
       apply(simp add: epdaH_configurations_def)
      apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
      apply(rule_tac
      d="da"
      in epdaH.belongs_configurations)
       apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
       apply(rule epdaH.derivation_initial_belongs)
        apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
        apply(simp add: valid_dpda_def valid_pda_def)
       apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
       apply(force)
      apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
      apply(force)
     apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
     apply(force)
    apply(rename_tac d i e q h s da db ib ea q2 s2 eb q1 s1 ha c)(*strict*)
    apply(clarsimp)
    apply(rename_tac d i h da db ib ea q2 s2 eb q1 s1 ha)(*strict*)
    apply(subgoal_tac "\<lparr>epdaH_conf_state = q1, epdaH_conf_history = h, epdaH_conf_stack = s1\<rparr> \<in> epdaH_configurations G'")
     apply(rename_tac d i h da db ib ea q2 s2 eb q1 s1 ha)(*strict*)
     apply(simp add: epdaH_configurations_def F_ALT_EPDA_RS_def Let_def)
     apply(case_tac "epda_initial G \<notin> Q")
      apply(rename_tac d i h da db ib ea q2 s2 eb q1 s1 ha)(*strict*)
      apply(clarsimp)
     apply(rename_tac d i h da db ib ea q2 s2 eb q1 s1 ha)(*strict*)
     apply(clarsimp)
    apply(rename_tac d i h da db ib ea q2 s2 eb q1 s1 ha)(*strict*)
    apply(rule_tac
      d="db"
      in epdaH.belongs_configurations)
     apply(rename_tac d i h da db ib ea q2 s2 eb q1 s1 ha)(*strict*)
     apply(rule epdaH.derivation_initial_belongs)
      apply(rename_tac d i h da db ib ea q2 s2 eb q1 s1 ha)(*strict*)
      apply(simp add: valid_dpda_def valid_pda_def)
     apply(rename_tac d i h da db ib ea q2 s2 eb q1 s1 ha)(*strict*)
     apply(force)
    apply(rename_tac d i h da db ib ea q2 s2 eb q1 s1 ha)(*strict*)
    apply(erule_tac
      x="i"
      in allE)
    apply(clarsimp)
    apply(force)
   apply(rename_tac d i e q h s h' da db ib ea q2 s2 eb q1 h1 s1 ha)(*strict*)
   apply(simp add: prefix_def)
   apply(clarsimp)
   apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c)(*strict*)
   apply(subgoal_tac "X" for X)
    apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c)(*strict*)
    prefer 2
    apply(rule_tac
      G="G"
      and ?d1.0="da"
      and ?d2.0="d"
      and x="0"
      and y="0"
      and n="i"
      and m="i"
      in epdaH.is_forward_deterministicHist_derivations_coincide)
               apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c)(*strict*)
               apply(simp add: valid_dpda_def valid_pda_def)
              apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c)(*strict*)
              apply(force)
             apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c)(*strict*)
             apply(force)
            apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c)(*strict*)
            apply (metis DPDA_is_is_forward_deterministicHist_SB)
           apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c)(*strict*)
           apply(simp add: epdaH.derivation_initial_def)
           apply(erule_tac
      x="0"
      in allE)
           apply(clarsimp)
           apply(case_tac "db 0")
            apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c)(*strict*)
            apply(clarsimp)
           apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c a)(*strict*)
           apply(clarsimp)
           apply(case_tac a)
           apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c a option b)(*strict*)
           apply(clarsimp)
           apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c b)(*strict*)
           apply(simp add: epdaH_initial_configurations_def)
           apply(clarsimp)
           apply(case_tac "d 0")
            apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c b)(*strict*)
            apply(clarsimp)
           apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c b a)(*strict*)
           apply(clarsimp)
           apply(case_tac a)
           apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c b a option ba)(*strict*)
           apply(clarsimp)
           apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c b ba)(*strict*)
           apply(simp add: epdaH_initial_configurations_def)
          apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c)(*strict*)
          apply(force)
         apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c)(*strict*)
         apply(force)
        apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c)(*strict*)
        apply(force)
       apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c)(*strict*)
       apply(force)
      apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c)(*strict*)
      apply(force)
     apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c)(*strict*)
     apply(clarsimp)
     apply(simp add: epda_effects_def)
     apply(simp add: get_configuration_def)
    apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c)(*strict*)
    apply(simp)
   apply(rename_tac d i e q s h' da db ib ea q2 s2 eb q1 h1 s1 c)(*strict*)
   apply(clarsimp)
   apply(rename_tac d i e q s h' da db ib ea q2 s2 h1)(*strict*)
   apply(subgoal_tac "\<lparr>epdaH_conf_state = q, epdaH_conf_history = h1, epdaH_conf_stack = s\<rparr> \<in> epdaH_configurations G'")
    apply(rename_tac d i e q s h' da db ib ea q2 s2 h1)(*strict*)
    apply(simp add: epdaH_configurations_def F_ALT_EPDA_RS_def Let_def)
    apply(case_tac "epda_initial G \<notin> Q")
     apply(rename_tac d i e q s h' da db ib ea q2 s2 h1)(*strict*)
     apply(clarsimp)
    apply(rename_tac d i e q s h' da db ib ea q2 s2 h1)(*strict*)
    apply(clarsimp)
   apply(rename_tac d i e q s h' da db ib ea q2 s2 h1)(*strict*)
   apply(rule_tac
      d="db"
      in epdaH.belongs_configurations)
    apply(rename_tac d i e q s h' da db ib ea q2 s2 h1)(*strict*)
    apply(rule epdaH.derivation_initial_belongs)
     apply(rename_tac d i e q s h' da db ib ea q2 s2 h1)(*strict*)
     apply(simp add: valid_dpda_def valid_pda_def)
    apply(rename_tac d i e q s h' da db ib ea q2 s2 h1)(*strict*)
    apply(force)
   apply(rename_tac d i e q s h' da db ib ea q2 s2 h1)(*strict*)
   apply(erule_tac
      x="i"
      in allE)
   apply(clarsimp)
   apply(force)
  apply(rename_tac d i e q h s h' da db ib ea q2 s2)(*strict*)
  apply(subgoal_tac "i=ib")
   apply(rename_tac d i e q h s h' da db ib ea q2 s2)(*strict*)
   prefer 2
   apply(force)
  apply(rename_tac d i e q h s h' da db ib ea q2 s2)(*strict*)
  apply(clarsimp)
  apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
  apply(subgoal_tac "X" for X)
   apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
   prefer 2
   apply(rule_tac
      G="G"
      and ?d1.0="d"
      and ?d2.0="da"
      and x="0"
      and y="0"
      and n="ib"
      and m="ib"
      in epdaH.is_forward_deterministicHist_derivations_coincide)
              apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
              apply(simp add: valid_dpda_def valid_pda_def)
             apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
             apply(force)
            apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
            apply(force)
           apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
           apply (metis DPDA_is_is_forward_deterministicHist_SB)
          apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
          apply(simp add: epdaH.derivation_initial_def)
          apply(erule_tac
      x="0"
      in allE)
          apply(clarsimp)
          apply(case_tac "db 0")
           apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
           apply(clarsimp)
          apply(rename_tac d e q h s h' da db ib ea q2 s2 a)(*strict*)
          apply(clarsimp)
          apply(case_tac a)
          apply(rename_tac d e q h s h' da db ib ea q2 s2 a option b)(*strict*)
          apply(clarsimp)
          apply(rename_tac d e q h s h' da db ib ea q2 s2 b)(*strict*)
          apply(simp add: epdaH_initial_configurations_def)
          apply(clarsimp)
          apply(case_tac "d 0")
           apply(rename_tac d e q h s h' da db ib ea q2 s2 b)(*strict*)
           apply(clarsimp)
          apply(rename_tac d e q h s h' da db ib ea q2 s2 b a)(*strict*)
          apply(clarsimp)
          apply(case_tac a)
          apply(rename_tac d e q h s h' da db ib ea q2 s2 b a option ba)(*strict*)
          apply(clarsimp)
          apply(rename_tac d e q h s h' da db ib ea q2 s2 b ba)(*strict*)
          apply(simp add: epdaH_initial_configurations_def)
         apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
         apply(force)
        apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
        apply(force)
       apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
       apply(force)
      apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
      apply(force)
     apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
     apply(force)
    apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
    apply(clarsimp)
    apply(simp add: epda_effects_def)
    apply(simp add: get_configuration_def)
    apply(subgoal_tac "\<lparr>epdaH_conf_state = q2, epdaH_conf_history = h @ h', epdaH_conf_stack = s2\<rparr> \<in> epdaH_configurations G")
     apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
     apply(simp add: epdaH_configurations_def)
    apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
    apply(rule_tac
      d="da"
      in epdaH.belongs_configurations)
     apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
     apply(rule epdaH.derivation_initial_belongs)
      apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
      apply(simp add: valid_dpda_def valid_pda_def)
     apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
     apply(force)
    apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
    apply(force)
   apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
   apply(force)
  apply(rename_tac d e q h s h' da db ib ea q2 s2)(*strict*)
  apply(clarsimp)
  apply(rename_tac d h da db ib ea q2 s2)(*strict*)
  apply(subgoal_tac "\<lparr>epdaH_conf_state = q2, epdaH_conf_history = h, epdaH_conf_stack = s2\<rparr> \<in> epdaH_configurations G'")
   apply(rename_tac d h da db ib ea q2 s2)(*strict*)
   apply(simp add: epdaH_configurations_def F_ALT_EPDA_RS_def Let_def)
   apply(case_tac "epda_initial G \<notin> Q")
    apply(rename_tac d h da db ib ea q2 s2)(*strict*)
    apply(clarsimp)
   apply(rename_tac d h da db ib ea q2 s2)(*strict*)
   apply(clarsimp)
  apply(rename_tac d h da db ib ea q2 s2)(*strict*)
  apply(rule_tac
      d="db"
      in epdaH.belongs_configurations)
   apply(rename_tac d h da db ib ea q2 s2)(*strict*)
   apply(rule epdaH.derivation_initial_belongs)
    apply(rename_tac d h da db ib ea q2 s2)(*strict*)
    apply(simp add: valid_dpda_def valid_pda_def)
   apply(rename_tac d h da db ib ea q2 s2)(*strict*)
   apply(force)
  apply(rename_tac d h da db ib ea q2 s2)(*strict*)
  apply(erule_tac
      x="ib"
      in allE)
  apply(clarsimp)
  apply(force)
  done

lemma F_EPDA_RS__enforces_retain_edges_between_retained_states: "
  valid_dpda G
  \<Longrightarrow> Q \<subseteq> epda_states G
  \<Longrightarrow> F_ALT_EPDA_RS G Q = Some G'
  \<Longrightarrow> retain_edges_between_retained_states G Q G'"
  apply(simp add: F_EPDA_R_def retain_edges_between_retained_states_def F_ALT_EPDA_RS_def Let_def F_EPDA_RS_def)
  apply(clarsimp)
  apply(rename_tac e)(*strict*)
  apply(case_tac "epda_initial G \<notin> Q")
   apply(rename_tac e)(*strict*)
   apply(clarsimp)
  apply(rename_tac e)(*strict*)
  apply(clarsimp)
  done

lemma F_ALT_EPDA_RS__SOUND: "
  F_EPDA_RS__SpecInput G Q
  \<Longrightarrow> F_EPDA_RS__SpecOutput G Q (F_ALT_EPDA_RS G Q)"
  apply(simp add: F_EPDA_RS__SpecOutput_def F_EPDA_RS__SpecInput_def)
  apply(clarsimp)
  apply(case_tac "F_ALT_EPDA_RS G Q")
   apply(clarsimp)
   apply(simp add: F_ALT_EPDA_RS_def)
  apply(rename_tac a)(*strict*)
  apply(clarsimp)
  apply(rename_tac G')
  apply(rename_tac G')(*strict*)
  apply(rule context_conjI)
   apply(rename_tac G')(*strict*)
   apply(rule F_ALT_EPDA_RS__preserves_valid_dpda)
     apply(rename_tac G')(*strict*)
     prefer 3
     apply(force)
    apply(rename_tac G')(*strict*)
    apply(force)
   apply(rename_tac G')(*strict*)
   apply(force)
  apply(rename_tac G')(*strict*)
  apply(rule conjI)
   apply(rename_tac G')(*strict*)
   apply(rule F_ALT_EPDA_RS__preserves_no_epda_livelock)
       apply(rename_tac G')(*strict*)
       prefer 3
       apply(force)
      apply(rename_tac G')(*strict*)
      apply(force)
     apply(rename_tac G')(*strict*)
     apply(force)
    apply(rename_tac G')(*strict*)
    apply(force)
   apply(rename_tac G')(*strict*)
   apply(force)
  apply(rename_tac G')(*strict*)
  apply(rule context_conjI)
   apply(rename_tac G')(*strict*)
   apply(rule F_ALT_EPDA_RS__no_modification)
      apply(rename_tac G')(*strict*)
      apply(force)
     apply(rename_tac G')(*strict*)
     apply(force)
    apply(rename_tac G')(*strict*)
    apply(force)
   apply(rename_tac G')(*strict*)
   apply(force)
  apply(rule conjI)
   apply(rule order_antisym)
    apply(rename_tac G')(*strict*)
    apply(force)
   apply(rename_tac G')(*strict*)
   apply(rule F_ALT_EPDA_RS__lang_modification)
          apply(rename_tac G')(*strict*)
          apply(force)
         apply(rename_tac G')(*strict*)
         apply(force)
        apply(rename_tac G')(*strict*)
        apply(force)
       apply(rename_tac G')(*strict*)
       apply(force)
      apply(rename_tac G')(*strict*)
      apply(force)
     apply(rename_tac G')(*strict*)
     apply(force)
    apply(rename_tac G')(*strict*)
    apply(force)
   apply(rename_tac G')(*strict*)
   apply(force)
  apply(rule F_EPDA_RS__enforces_retain_edges_between_retained_states)
    apply(force)
   apply(force)
  apply(force)
  done

theorem F_EPDA_RS__SOUND: "
  F_EPDA_RS__SpecInput G Q
  \<Longrightarrow> F_EPDA_RS__SpecOutput G Q (F_EPDA_RS G Q)"
  apply(rule_tac t="F_EPDA_RS G Q" and s="F_ALT_EPDA_RS G Q" in subst)
   apply(rule F_EPDA_RS__vs_F_ALT_EPDA_RS)
    apply(simp add: F_EPDA_RS__SpecInput_def)
    apply(simp add: valid_dpda_def valid_pda_def)
   apply(simp add: F_EPDA_RS__SpecInput_def)
  apply(rule F_ALT_EPDA_RS__SOUND)
  apply(force)
  done

hide_const F_ALT_EPDA_RS
hide_fact F_EPDA_RS__vs_F_ALT_EPDA_RS
hide_fact F_ALT_EPDA_RS__preserves_valid_pda
hide_fact F_ALT_EPDA_RS__preserves_valid_dpda
hide_fact F_ALT_EPDA_RS__preserves_no_epda_livelock
hide_fact F_ALT_EPDA_RS__no_modification
hide_fact F_ALT_EPDA_RS__lang_modification
hide_fact F_ALT_EPDA_RS__SOUND
hide_fact F_EPDA_RS__enforces_retain_edges_between_retained_states

end


(*  Title:      HOL/Auth/n_germanish_lemma_invs_on_rules.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_germanish Protocol Case Study*}

theory n_germanish_lemma_invs_on_rules imports n_germanish_lemma_inv__1_on_rules n_germanish_lemma_inv__2_on_rules n_germanish_lemma_inv__3_on_rules
begin
lemma invs_on_rules:
  assumes a1: "f \<in> invariants N" and a2: "r \<in> rules N"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have b1: "(\<exists> p__Inv0 p__Inv2. p__Inv0\<le>N\<and>p__Inv2\<le>N\<and>p__Inv0~=p__Inv2\<and>f=inv__1  p__Inv0 p__Inv2)\<or>
    (\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__2  p__Inv2)\<or>
    (\<exists> p__Inv0 p__Inv2. p__Inv0\<le>N\<and>p__Inv2\<le>N\<and>p__Inv0~=p__Inv2\<and>f=inv__3  p__Inv0 p__Inv2)"
  apply (cut_tac a1, auto) done
    moreover {
      assume c1: "(\<exists> p__Inv0 p__Inv2. p__Inv0\<le>N\<and>p__Inv2\<le>N\<and>p__Inv0~=p__Inv2\<and>f=inv__1  p__Inv0 p__Inv2)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac a2 c1, metis lemma_inv__1_on_rules) done
    }

    moreover {
      assume c1: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__2  p__Inv2)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac a2 c1, metis lemma_inv__2_on_rules) done
    }

    moreover {
      assume c1: "(\<exists> p__Inv0 p__Inv2. p__Inv0\<le>N\<and>p__Inv2\<le>N\<and>p__Inv0~=p__Inv2\<and>f=inv__3  p__Inv0 p__Inv2)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac a2 c1, metis lemma_inv__3_on_rules) done
    }

  ultimately show "invHoldForRule s f r (invariants N)"
  by satx
qed

end